Next Chapter 58 Stock Statement
PROJECT SOURCE CODE
SPONSORED LINKS
Stock Statement
'******************************************************************
'******************************************************************
'** Author : Samee Ullah Siddiqui
'** Subject : Creating Stock Statement Report
'** Date : Wednesday, September, 10, 2003
'** Modified : Wednesday, September, 10, 2003
'******************************************************************
'******************************************************************
Dim TerminateLoop As Boolean
Private Sub CancelCmd_Click()
Unload Me
End Sub
Private Sub DtFrom_Validate(Cancel As Boolean)
If Not IsDate(DtFrom) Then
MsgBox "Please enter a valid date.", vbCritical, "Invalid Date"
Cancel = True
DtFrom.SetFocus
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then SendKeys "{TAB}"
End Sub
Private Sub Form_Load()
Dim SQL As String
DtFrom = SelectedCompany.FromDate
DtTo = Date
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
manufCB.AddItem "(All)"
manufCB.ListIndex = 0
GroupCB.AddItem "(All)"
GroupCB.ListIndex = 0
' SubGroupCB.AddItem "(All)"
' SubGroupCB.ListIndex = 0
'
' SizeRollCB.AddItem "(All)"
' SizeRollCB.ListIndex = 0
'Populate Manufacturer Combo
With manufCB
SQL = "SELECT ManufCode, Manuf_Desc FROM MANUFACTURER ORDER BY Manuf_Desc"
rst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
Do Until rst.EOF
.AddItem rst!MANUF_DESC
.ItemData(.NewIndex) = rst!MANUFCODE
rst.MoveNext
Loop
End With
'Populate Item Group Combo
With GroupCB
SQL = "SELECT IGCode, IGDesc FROM ITEMGROUP ORDER BY IGDesc"
If rst.State = adStateOpen Then rst.Close
rst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
Do Until rst.EOF
.AddItem rst!IGDesc
.ItemData(.NewIndex) = rst!IGCode
rst.MoveNext
Loop
End With
' 'Populate Item Sub Group Combo
' With SubGroupCB
' SQL = "SELECT ISGCode, ISGDesc FROM ITEMSUBGROUP ORDER BY ISGDesc"
' If Rst.State = adStateOpen Then Rst.Close
' Rst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
' Do Until Rst.EOF
' .AddItem Rst!ISGDesc
' .ItemData(.NewIndex) = Rst!ISGCode
' Rst.MoveNext
' Loop
' End With
'
' 'Populate SizeRoll Combo
' With SizeRollCB
' SQL = "SELECT SizeRollCode, Sizeroll FROM SIZEROLL ORDER BY Sizeroll"
' If Rst.State = adStateOpen Then Rst.Close
' Rst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
' Do Until Rst.EOF
' .AddItem Rst!SizeRoll
' .ItemData(.NewIndex) = Rst!SizeRollCode
' Rst.MoveNext
' Loop
' End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
End Sub
Private Sub SetCmds(ByVal Status As Boolean)
OKCmd.Caption = IIf(Not Status, "&Abort", "&OK")
CancelCmd.Enabled = Status
End Sub
Private Sub OKCmd_Click()
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
If OKCmd.Caption = "&Abort" Then
TerminateLoop = True
Else
Dim SQL, Manuf, SizeRoll, IGroup, ISGroup, WhereClouse As String
Manuf = IIf(manufCB.Text = "(All)", "", " AND ItemDetails.ManufCode ='" & GetProperCode(CStr(manufCB.ItemData(manufCB.ListIndex)), 4) & "'")
IGroup = IIf(GroupCB.Text = "(All)", "", " AND ItemDetails.IGCode ='" & GetProperCode(CStr(GroupCB.ItemData(GroupCB.ListIndex)), 4) & "'")
'ISGroup = IIf(SubGroupCB.Text = "(All)", "", " AND ItemDetails.ISGCode ='" & GetProperCode(CStr(SubGroupCB.ItemData(SubGroupCB.ListIndex)), 4) & "'")
'SizeRoll = IIf(SizeRollCB.Text = "(All)", "", " AND ItemDetails.SizeRollCode ='" & GetProperCode(CStr(SizeRollCB.ItemData(SizeRollCB.ListIndex)), 4) & "'")
ISGroup = ""
SizeRoll = ""
If DE.StatementConn.State = adStateOpen Then DE.StatementConn.Close
DE.StatementConn.Open ShapeConnectString
DE.StatementConn.BeginTrans
Me.MousePointer = vbHourglass
If CalcChk.Value = vbChecked Then
Call SetCmds(False)
TerminateLoop = False 'Flage to Terminate loop between process time
'Calculating recent purchase & opening rate AND Update ItemSize table
SQL = "SELECT DISTINCT ledger.ICODE, ledger.ISIZE, ItemDetails.[Item Name] FROM ledger INNER JOIN ItemDetails ON ledger.ICODE = ItemDetails.ItemCode " & IIf(Manuf & IGroup = "", Null, " WHERE " & Manuf & IGroup) & " ORDER BY ledger.ICODE, ledger.ISIZE"
rst.Open SQL, DE.StatementConn, adOpenForwardOnly, adLockReadOnly, adCmdText
Do Until rst.EOF Or TerminateLoop
SQL = "UPDATE ITEMSIZE SET OPPRCHRATE = " & RecentRate(rst!ICODE, "PV", rst!ISIZE, DtFrom.Value) & ", PRCHRATE = " & RecentRate(rst!ICODE, "PV", rst!ISIZE) & " Where ICODE = '" & rst!ICODE & "' AND ISIZE = " & rst!ISIZE
DE.StatementConn.Execute SQL, , adCmdText
'stsLBL.Caption = "Gathering information of recent purchase rate of" & vbCrLf & "Item: " & Rst("Item Name") & " , Size: " & Rst!ISIZE
stsLBL.Caption = "Gathering recent purchase rate of sold items" & vbCrLf & "Processing Completed " & Round((rst.AbsolutePosition / (rst.RecordCount / 100)), 0) & "%"
DoEvents
rst.MoveNext
Loop
Call SetCmds(True)
If TerminateLoop Then 'If process Terminate
DE.StatementConn.RollbackTrans
Me.MousePointer = vbDefault
stsLBL.Caption = ""
Exit Sub
End If
End If
'Deleting previous records in the table
DE.StatementConn.Execute "DELETE FROM tblTempStatement", , adCmdText
'Appending Opening date data
stsLBL.Caption = "Gathering information of item opening"
Dim OpeningQty As String
OpeningQty = "((Sum(CASE WHEN VTYPE='OP' THEN QTY ELSE 0 END ) + Sum(CASE WHEN VTYPE='PV' THEN QTY ELSE 0 END) + Sum(CASE WHEN VTYPE='SR' THEN QTY ELSE 0 END)) - (Sum(CASE WHEN VTYPE='PR' THEN QTY ELSE 0 END) + Sum( CASE WHEN VTYPE='SV' THEN QTY ELSE 0 END)))"
SQL = "INSERT INTO tblTempStatement (ICODE, ISIZE, ITEM_DESC, OpeningQty, OpeningValue, PurchaseQty, PurchaseValue, SaleQty, SaleValue) "
SQL = SQL & "SELECT Ledger.ICODE, Ledger.ISIZE, ItemDetails.[Item Name]," & OpeningQty & " AS OpeningQty, " & _
"(" & OpeningQty & " * (SELECT OPPrchRate from ITEMSIZE Where ICode = Ledger.ICode AND ISIZE = Ledger.ISize)) AS OpeningValue, 0, 0, 0, 0 FROM Ledger INNER JOIN ItemDetails ON Ledger.ICODE = ItemDetails.ItemCode Where (Ledger.vDate < '" & DtFrom.Value & "') " & Manuf & IGroup & ISGroup & SizeRoll & " GROUP BY Ledger.ICODE, Ledger.ISIZE, ItemDetails.[Item Name];"
DE.StatementConn.Execute SQL, , adCmdText
stsLBL.Caption = "Creating stock statement"
'Appending Between date data
'Dim PurchaseQty As String
'PurchaseQty = "((Sum(CASE WHEN VTYPE='OP' THEN QTY ELSE 0 END ) + Sum(CASE WHEN VTYPE='PV' THEN QTY ELSE 0 END) + Sum(CASE WHEN VTYPE='SR' THEN QTY ELSE 0 END)) - (Sum(CASE WHEN VTYPE='PR' THEN QTY ELSE 0 END) + Sum( CASE WHEN VTYPE='SV' THEN QTY ELSE 0 END)))"
SQL = "INSERT INTO tblTempStatement (ICODE, ISIZE, ITEM_DESC, OpeningQty, OpeningValue, PurchaseQty, PurchaseValue, SaleQty, SaleValue) "
SQL = SQL & " SELECT Ledger.ICODE, Ledger.ISIZE, ItemDetails.[Item Name], Sum(CASE WHEN VTYPE='OP' THEN QTY ELSE 0 END) as OpeningQty, (Sum(CASE WHEN VTYPE='OP' THEN QTY ELSE 0 END) * Ledger.[Rate]) AS OpeningValue, (Sum(CASE WHEN VTYPE='PV' THEN QTY ELSE 0 END) - Sum( CASE WHEN VTYPE='PR' THEN QTY ELSE 0 END)) AS PurchaseQty, " & _
"Sum((CASE WHEN VTYPE='PV' THEN QTY ELSE 0 END - CASE WHEN VTYPE='PR' THEN QTY ELSE 0 END) * Ledger.[Rate]) AS PurchaseValue, (Sum(CASE WHEN VTYPE='SV' THEN QTY ELSE 0 END) - Sum( CASE WHEN VTYPE='SR' THEN QTY ELSE 0 END)) AS SaleQty, Sum((CASE WHEN VTYPE='SV' THEN QTY ELSE 0 END - CASE WHEN VTYPE='SR' THEN QTY ELSE 0 END) * Ledger.[Rate]) AS SaleValue " & _
"FROM Ledger INNER JOIN ItemDetails ON Ledger.ICODE = ItemDetails.ItemCode " & _
"WHERE ((Ledger.VDATE Between '" & DtFrom.Value & "' And '" & DtTo.Value & "') " & Manuf & IGroup & ISGroup & SizeRoll & ") " & _
" GROUP BY Ledger.ICODE, Ledger.ISIZE, ItemDetails.[Item Name],LEDGER.[RATE];"
DE.StatementConn.Execute SQL, , adCmdText
DE.StatementConn.CommitTrans
stsLBL.Caption = ""
SQL = "SHAPE {SELECT ICODE, Item_Desc, ISIZE, SUM(OpeningQty) AS OPQty, " & _
"SUM(OpeningValue) AS OPValue, SUM(PurchaseQty) AS PrchQty, SUM(PurchaseValue) AS PrchValue, " & _
"SUM(SaleValue) AS SaleValues, SUM(SaleQty) AS SaleQtys, (SUM(OpeningQty) + SUM(PurchaseQty) - SUM(SaleQty)) AS BalanceQty, " & _
"((SUM(OpeningQty) + SUM(PurchaseQty) - SUM(SaleQty)) * (SELECT PRCHRATE FROM ITEMSIZE WHERE ITEMSIZE.ICODE = tblTempStatement.ICODE AND ITEMSIZE.ISIZE = tblTempStatement.ISIZE)) AS BALANCEVALUE FROM tblTempStatement GROUP BY ICODE, ISIZE, Item_Desc} " & _
"AS StatementCmd COMPUTE StatementCmd, SUM(StatementCmd.'OPQty') AS SumOpeningQty, SUM(StatementCmd.'OPValue') AS SumOpeningValue, SUM(StatementCmd.'PrchQty') AS SumPrchQty, SUM(StatementCmd.'PrchValue') AS SumPrchValue, SUM(StatementCmd.'SaleQtys') AS SumSaleQty, SUM(StatementCmd.'SaleValues') AS SumSaleValue, SUM(StatementCmd.'BalanceQty') AS SumBalanceQty, SUM(StatementCmd.'BALANCEVALUE') AS SumBalanceValue BY 'Item_Desc'"
If DE.rsStatementCmd_Grouping.State = adStateOpen Then DE.rsStatementCmd_Grouping.Close
DE.rsStatementCmd_Grouping.Open SQL, DE.StatementConn, adOpenStatic, adLockOptimistic, adCmdText
Me.MousePointer = vbDefault
Set StatementRpt.DataSource = DE
With StatementRpt
.Sections("ReportHeader").Controls("DtLbl").Caption = "Statement Date From: " & Format(DtFrom.Value, "dd-mm-yyyy") & " To: " & Format(DtTo.Value, "dd-mm-yyyy")
.Sections("StatementCmd_Grouping_Header").Controls("Label4").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Grouping_Header").Controls("Label6").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Grouping_Header").Controls("Label8").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Grouping_Header").Controls("Label10").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Grouping_Header").Controls("Shape11").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Grouping_Header").Controls("Shape14").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Grouping_Header").Controls("Shape15").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Grouping_Header").Controls("Shape16").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Detail").Controls("txtISIZE").BorderStyle = IIf(ValueChk.Value = vbChecked, 1, 0)
.Sections("StatementCmd_Detail").Controls("txtOpeningQty").BorderStyle = IIf(ValueChk.Value = vbChecked, 1, 0)
.Sections("StatementCmd_Detail").Controls("txtPurchaseQty").BorderStyle = IIf(ValueChk.Value = vbChecked, 1, 0)
.Sections("StatementCmd_Detail").Controls("txtSaleQty").BorderStyle = IIf(ValueChk.Value = vbChecked, 1, 0)
.Sections("StatementCmd_Detail").Controls("txtBalanceQty").BorderStyle = IIf(ValueChk.Value = vbChecked, 1, 0)
.Sections("StatementCmd_Detail").Controls("txtOpeningValue").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Detail").Controls("txtPurchaseValue").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Detail").Controls("txtSaleValue").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Detail").Controls("txtBalanceValue").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Grouping_Footer").Controls("txtSumOpeningValue").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Grouping_Footer").Controls("txtSumPrchValue").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Grouping_Footer").Controls("txtSumSaleValue").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Grouping_Footer").Controls("txtSumBalanceValue").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Grouping_Footer").Controls("Shape23").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Grouping_Footer").Controls("Shape24").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Grouping_Footer").Controls("Shape25").Visible = (ValueChk.Value = vbChecked)
.Sections("StatementCmd_Grouping_Footer").Controls("Shape26").Visible = (ValueChk.Value = vbChecked)
.Sections("ReportFooter").Controls("Function2").Visible = (ValueChk.Value = vbChecked)
.Sections("ReportFooter").Controls("Function5").Visible = (ValueChk.Value = vbChecked)
.Sections("ReportFooter").Controls("Function6").Visible = (ValueChk.Value = vbChecked)
.Sections("ReportFooter").Controls("Function8").Visible = (ValueChk.Value = vbChecked)
.Sections("ReportFooter").Controls("Shape31").Visible = (ValueChk.Value = vbChecked)
.Sections("ReportFooter").Controls("Shape32").Visible = (ValueChk.Value = vbChecked)
.Sections("ReportFooter").Controls("Shape33").Visible = (ValueChk.Value = vbChecked)
.Sections("ReportFooter").Controls("Shape34").Visible = (ValueChk.Value = vbChecked)
End With
On Error GoTo ErHand
If Option1(0).Value Then StatementRpt.Show Else StatementRpt.PrintReport
End If
ErHand:
ErrHandler "SaleFrm.CmdPrint"
End Sub