Next Chapter 59 Stock Ledger

PROJECT SOURCE CODE

SPONSORED LINKS

Stock Ledger

'******************************************************************

'** Author : Samee Ullah Siddiqui

'** Subject : Stock Ledger Report

'** Date : Saturday, September, 20, 2003

'** Modified : Tuesday, September, 23, 2003

'******************************************************************

Dim TEMPRST As ADODB.Recordset

Dim SQL As String

Private Sub CancelCmd_Click()

Unload Me

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

If Me.ActiveControl.Name = "ArgTxt" Then Exit Sub

If KeyCode = vbKeyReturn Then SendKeys "{TAB}"

If KeyCode = vbKeyEscape Then Call CancelCmd_Click

End Sub

Private Sub Form_Load()

DtFrom.Value = SelectedCompany.FromDate

DtTo.Value = Date

Set TEMPRST = New ADODB.Recordset

TEMPRST.CursorLocation = adUseClient

'Prepare Search Object

With Sobj

.DBConnectString = ConnectString

.SQLString = "SELECT ItemCode, Item_Desc FROM ITEM"

.PopulateList

Set .BoundTextBox = ArgTxt

End With

End Sub

Private Sub Form_Unload(Cancel As Integer)

On Error Resume Next

TEMPRST.Close

Set TEMPRST = Nothing

End Sub

Private Sub OKCmd_Click()

Dim SQL As String

If ArgTxt.Tag = "" Then

MsgBox "Please Select Item to generate ledger.", vbCritical, "Missing Value"

ArgTxt.SetFocus

Exit Sub

End If

If DE.StockLgrConn.State = adStateOpen Then DE.StockLgrConn.Close

DE.StockLgrConn.Open ConnectString

Call PrepareStockLedgerData

If DE.rsStockLgrCmd.State = adStateOpen Then DE.rsStockLgrCmd.Close

DE.rsStockLgrCmd.Open "Select * From Stock_Ledger_Temp", DE.StockLgrConn, adOpenStatic, adLockReadOnly, adCmdText

Set StockLgrRpt.DataSource = DE

StockLgrRpt.Sections("ReportHeader").Controls("DtLbl").Caption = "Ledger Date From: " & Format(DtFrom.Value, "dd-mm-yyyy") & " To: " & Format(DtTo.Value, "dd-mm-yyyy")

StockLgrRpt.Sections("ReportHeader").Controls("ItemLbl").Caption = "Item : " & ArgTxt.Text

On Error GoTo ErHand

If Option1(0).Value Then

StockLgrRpt.Show

Else

StockLgrRpt.PrintReport

End If

ErHand:

ErrHandler "StockLgrFrm.CmdPrint"

End Sub

Private Function PrepareStockLedgerData() As Boolean

Dim VoucherType As String

Dim Qty, OpeningQty, SaleQty, SaleReturnQty, PurchaseQty, PurchaseReturnQty, BalanceQty As Double

Dim TempTable As New ADODB.Recordset

TempTable.CursorLocation = adUseClient

Dim rst As New ADODB.Recordset

rst.CursorLocation = adUseClient

DE.StockLgrConn.BeginTrans

'Get Opening Quantity

SQL = "SELECT Ledger.VDATE, Sum(CASE WHEN VTYPE='OP' THEN Qty ELSE 0 END) AS OPQTY, Sum( CASE WHEN VTYPE='PV' THEN Qty ELSE 0 END) AS PVQTY, Sum(CASE WHEN VTYPE='PR' THEN Qty ELSE 0 END ) AS PRQTY, " & _

"Sum(CASE WHEN VTYPE='SV' THEN Qty ELSE 0 END ) AS SVQTY, Sum(CASE WHEN VTYPE='SR' THEN Qty ELSE 0 END ) AS SRQTY From Ledger WHERE (((Ledger.ICODE)='" & ArgTxt.Tag & "') AND (Ledger.VDATE < '" & DtFrom.Value & "')) GROUP BY Ledger.VDATE;"

rst.Open SQL, DE.StockLgrConn, adOpenKeyset, adLockReadOnly, adCmdText

If rst.RecordCount > 0 Then OpeningQty = (IIf(IsNull(rst!OPQTY), 0, rst!OPQTY) + IIf(IsNull(rst!PVQTY), 0, rst!PVQTY) + IIf(IsNull(rst!SRQTY), 0, rst!SRQTY)) - (IIf(IsNull(rst!SVQTY), 0, rst!SVQTY) + IIf(IsNull(rst!PRQTY), 0, rst!PRQTY))

'Delete Old Records from Ledger Temporary Table

DE.StockLgrConn.Execute "DELETE FROM STOCK_LEDGER_TEMP", , adCmdText

'Transaction of Selected Item

If rst.State = adStateOpen Then rst.Close

SQL = "SELECT Ledger.VDATE, Ledger.VNO, Ledger.VTYPE, Sum(Ledger.QTY) AS SumOfQTY, Sale.ACDESC AS PartyName, Purchase.ACDESC AS SupplierName, Purchase.SUPP_INV_NO AS InvoiceNo, Purchase.SUPP_INV_DATE AS InvoiceDate " & _

"FROM Purchase RIGHT JOIN (Sale RIGHT JOIN Ledger ON (Sale.VTYPE = Ledger.VTYPE) AND (Sale.VNO = Ledger.VNO)) ON (Purchase.VNO = Ledger.VNO) AND (Purchase.VTYPE = Ledger.VTYPE) " & _

"WHERE (((Ledger.ICODE)='" & ArgTxt.Tag & "') AND (Ledger.VDATE BETWEEN '" & DtFrom.Value & "' AND '" & DtTo.Value & "')) " & _

"GROUP BY Ledger.VDATE, Ledger.VNO, Ledger.VTYPE, Sale.ACDESC, Purchase.ACDESC, Purchase.SUPP_INV_NO, Purchase.SUPP_INV_DATE ORDER BY LEDGER.VDATE, CONVERT(INT,SUBSTRING(LEDGER.VNO,2,LEN(LEDGER.VNO)-1))"

'MsgBox SQL

rst.Open SQL, DE.StockLgrConn, adOpenKeyset, adLockReadOnly, adCmdText

If Not rst.RecordCount > 0 Then GoTo EndLabel

TempTable.Open "Select * From Stock_Ledger_Temp", DE.StockLgrConn, adOpenKeyset, adLockOptimistic, adCmdText

With TempTable

rst.MoveFirst

Do Until rst.EOF

.AddNew

!vDate = IIf(IsNull(rst!vDate), Null, rst!vDate)

Qty = IIf(IsNull(rst!SumOfQty), 0, rst!SumOfQty)

VoucherType = UCase(IIf(IsNull(rst!VType), "", rst!VType))

!VType = VoucherType

!OPENING = (BalanceQty + OpeningQty)

Select Case VoucherType

Case "SV" 'Sale Voucher

!Vno = "To Sale Voucher No.: " & IIf(IsNull(rst!Vno), "", rst!Vno)

!Desc1 = "Sale To: " & IIf(IsNull(rst!partyname), "", rst!partyname)

!Sale = Qty

SaleQty = Qty

Case "SR" 'Sale Voucher

!Vno = "By Credit Note No.: " & IIf(IsNull(rst!Vno), "", rst!Vno)

!Desc1 = "Party : " & IIf(IsNull(rst!partyname), "", rst!partyname)

!SaleRtrn = Qty

SaleReturnQty = Qty

Case "OP" 'Opening Item Voucher

!Vno = "By Opening Voucher No.: " & IIf(IsNull(rst!Vno), "", rst!Vno)

!OPENING = !OPENING + Qty

OpeningQty = Qty

Case "PV" 'Purchase Voucher

!Vno = "By MRN No.: " & IIf(IsNull(rst!Vno), "", rst!Vno)

!Desc1 = "Supplier Name: " & IIf(IsNull(rst!SupplierName), "", rst!SupplierName)

!Desc2 = "Supplier Invoice No.: " & IIf(IsNull(rst!INVOICENO), "", rst!INVOICENO) & " Date : " & IIf(IsNull(rst!INVOICEDATE), Null, Format(rst!INVOICEDATE, "dd/mm/yyyy"))

!Purchase = Qty

PurchaseQty = Qty

Case "PR" 'Purchase Return

!Vno = "To Debit Note No.: " & IIf(IsNull(rst!Vno), "", rst!Vno)

!Desc1 = "Supplier Name: " & IIf(IsNull(rst!SupplierName), "", rst!SupplierName)

!Desc2 = "Supplier Invoice No.: " & IIf(IsNull(rst!INVOICENO), "", rst!INVOICENO) & " Date : " & IIf(IsNull(rst!INVOICEDATE), Null, Format(rst!INVOICEDATE, "dd/mm/yyyy"))

!PurchaseRtrn = Qty

PurchaseReturnQty = Qty

End Select

BalanceQty = (BalanceQty + OpeningQty + PurchaseQty + SaleReturnQty) - (SaleQty + PurchaseReturnQty)

!BALANCE = BalanceQty

OpeningQty = 0: PurchaseQty = 0: SaleReturnQty = 0: SaleQty = 0: PurchaseReturnQty = 0

rst.MoveNext

Loop

.Update

End With

EndLabel:

DE.StockLgrConn.CommitTrans

PrepareStockLedgerData = True

End Function

'Private Sub Timer11_Timer()

'On Error Resume Next

' If Not (ActiveControl.Name = "ArgTxt") Then

' If Sobj.ListVisible Then Sobj.HideList

' ElseIf (ActiveControl.Name = "ArgTxt") Then

' If Not Sobj.ListVisible Then

' Sobj.ShowList 490, 80, , MDIFrm

' If ActiveControl.Name = "ArgTxt" Then ArgTxt.SetFocus

' End If

'

'End Sub