Next Chapter 25 Birds Eye View
'******************************************************************
'******************************************************************
'** Author : Samee Ullah Siddiqui
'** Subject : Birds Eye View
'** Date : Thursday, October, 30, 2003
'** Modified : Saturday, November, 01, 2003
'******************************************************************
'******************************************************************
Dim LastRow As Integer
Const NumFormat As String = "#0.#0"
Dim OneStepBack As Boolean
Private Sub Form_Load()
Call SetGridFormat(True)
Call SetGridValues
End Sub
Private Sub SetGridValues()
Dim SQL, Item As String
Dim rst As New ADODB.Recordset
SQL = "SELECT ACMAST.MODIFY, ACMAST.ACCODE, ACMAST.ACDESC, ACMAST.ACALIAS, ACMAST.RECTYPE, ACMAST.CASH, ACMAST.GRCODE, ACMAST.ACTYPE, ACMAST.[LEVEL], ACMAST.BSHEET, AcTrans.CLOSING, AcTrans.YOBDR, AcTrans.YOBCR " & _
"FROM ACMAST INNER JOIN AcTrans ON ACMAST.ACCODE = AcTrans.Accode WHERE ACMAST.RECTYPE = 'G' AND (ACMAST.GRCODE IS NULL OR ACMAST.GRCODE='') ORDER BY ACMAST.ACDESC"
rst.CursorLocation = adUseClient
rst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
Call PopulateGridValues(rst)
End Sub
Private Sub PopulateGridValues(ByVal rst As ADODB.Recordset, Optional ISGroup As Boolean = True)
'To Populate Recordset in the grid
'On Error Resume Next
Dim Msg As String
With Grd
If Not rst.RecordCount > 0 Then
MsgBox "There is no transaction for this record.", vbExclamation, "No Transaction"
'Grd.SetFocus
'Grd.ListItems(LastRow).Selected = True
Exit Sub
End If
.ListItems.Clear
If ISGroup Then
Do Until rst.EOF
With .ListItems.Add(, , rst!RECTYPE)
.ListSubItems.Add , "ACDESC", rst!AcDESC
.ListSubItems.Add , "DEBIT", Format(IIf(rst!CLOSING <= 0, "", rst!CLOSING), NumFormat)
.ListSubItems.Add , "CREDIT", Format(IIf(rst!CLOSING < 0, Abs(rst!CLOSING), ""), NumFormat)
.ListSubItems.Add , "ACCODE", rst!AcCode
.ListSubItems.Add , "GRCODE", IIf(IsNull(rst!GrCode), "", rst!GrCode)
rst.MoveNext
End With
Loop
Else
Do Until rst.EOF
With .ListItems.Add(, , Format(rst!vDate, "dd mmm yy"))
.ListSubItems.Add , "ACDESC", rst!ACONTRADESC
.ListSubItems.Add , "DEBIT", Format(IIf(rst!DrAmt <= 0, "", rst!DrAmt), NumFormat)
.ListSubItems.Add , "CREDIT", Format(IIf(rst!CrAmt > 0, Abs(rst!CrAmt), ""), NumFormat)
.ListSubItems.Add , "ACCODE", rst!AcCode
.ListSubItems.Add , "GRCODE", IIf(IsNull(rst!GrCode), "", rst!GrCode)
rst.MoveNext
End With
Loop
End If
Call GetDebitCreditTotal
End With
End Sub
Private Sub GetDebitCreditTotal()
'To display debit & credit side total and calculate difference
'Called in SetGridValues()
Dim Diff, DrTotal, CrTotal As Double
DrTotal = SumOfColumn("DEBIT")
CrTotal = SumOfColumn("CREDIT")
Diff = Abs(DrTotal - CrTotal)
DiffDebitLbl = Format(IIf(DrTotal < CrTotal, Diff, ""), NumFormat)
DiffCreditLbl = Format(IIf(CrTotal < DrTotal, Diff, ""), NumFormat)
DebitLbl = DrTotal + Val(DiffDebitLbl)
DebitLbl = Format(DebitLbl, NumFormat)
CreditLbl = CrTotal + Val(DiffCreditLbl)
CreditLbl = Format(CreditLbl, NumFormat)
If Grd.SelectedItem.ListSubItems("GRCODE") = "000021" Then 'Profit & Loss Account
If DiffDebitLbl <> "" Then
DiffLbl = "Profit transferred to B/S"
ElseIf DiffCreditLbl <> "" Then
DiffLbl = "Loss transferred to B/S"
End If
Else
DiffLbl = "Difference in Opening :"
End If
End Sub
Private Function SumOfColumn(ByVal ColKey As String) As Double
'To get the Sum of Whole given column's value
'Called in GetDebitCreditTotal()
Dim LItem As ListItem
Dim i, vSumVal As Double
For Each LItem In Grd.ListItems
vSumVal = vSumVal + Val(LItem.ListSubItems(ColKey).Text)
Next
SumOfColumn = vSumVal
End Function
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
End Sub
Private Sub SetGridFormat(ByVal ISGroup As Boolean)
Dim i As Integer
With Grd
' .ListItems.Clear
.ColumnHeaders.Clear
.View = lvwReport
If ISGroup Then
.ColumnHeaders.Add , "G/A", "G/A", TextWidth("A") * 6, 0
.ColumnHeaders.Add , "Particulars", "Particulars", TextWidth("A") * 56, 0
.ColumnHeaders.Add , "Debit", "Debit", TextWidth("A") * 20, 1
.ColumnHeaders.Add , "Credit", "Credit", TextWidth("A") * 20, 1
.ColumnHeaders.Add , "ACCODE", "ACCODE", 0, 0 'Account Code
.ColumnHeaders.Add , "GRCODE", "GRCODE", 0, 0 'Group Code
Else
.ColumnHeaders.Add , "Date", "Date", TextWidth("A") * 14, 0
.ColumnHeaders.Add , "Particulars", "Particulars", TextWidth("A") * 52, 0
.ColumnHeaders.Add , "Debit", "Debit", TextWidth("A") * 17, 1
.ColumnHeaders.Add , "Credit", "Credit", TextWidth("A") * 17, 1
.ColumnHeaders.Add , "ACCODE", "ACCODE", 0, 0 'Account Code
.ColumnHeaders.Add , "GRCODE", "GRCODE", 0, 0 'Group Code
End If
End With
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim SQL, Item, GR As String
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
If Grd.SelectedItem Is Nothing Then Exit Sub
If KeyCode = vbKeyReturn Then
LastRow = Grd.SelectedItem.Index
Call SetGridFormat(Grd.SelectedItem.Text = "G")
If Grd.SelectedItem.Text = "G" Then
SQL = "SELECT ACMAST.MODIFY, ACMAST.ACCODE, ACMAST.ACDESC, ACMAST.ACALIAS, ACMAST.RECTYPE, ACMAST.CASH, ACMAST.GRCODE, ACMAST.ACTYPE, ACMAST.[Level], ACMAST.BSHEET, AcTrans.CLOSING, AcTrans.YOBDR, AcTrans.YOBCR " & _
"FROM ACMAST INNER JOIN AcTrans ON ACMAST.ACCODE = AcTrans.Accode WHERE ACMAST.GRCODE = '" & Grd.SelectedItem.ListSubItems("ACCODE").Text & "' ORDER BY ACMAST.ACDESC"
Call DisplayAccountStatus
Else 'If Press Enter On Account 'A'
SQL = "SELECT Voucher.VNO, Voucher.VTYPE, Voucher.VDATE, Voucher.ACCODE, tblACCODE.ACDESC, tblACCODE.GRCODE, tblACCODE.GROUPDESC, Voucher.ACCONTRA, tblACONTRA.ACDESC AS ACONTRADESC, tblACONTRA.GRCODE AS ACONTRAGRCODE, tblACONTRA.GROUPDESC AS ACONTRAGROUPDESC, Voucher.DRAMT, Voucher.CRAMT, Voucher.DRCR " & _
"FROM ACCOUNTS AS tblACONTRA INNER JOIN (Voucher INNER JOIN ACCOUNTS AS tblACCODE ON Voucher.ACCODE = tblACCODE.ACCODE) ON tblACONTRA.ACCODE = Voucher.ACCONTRA WHERE Voucher.ACCODE = '" & Grd.SelectedItem.ListSubItems("ACCODE").Text & "' ORDER BY Voucher.VDATE"
OneStepBack = True
End If
rst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
Call PopulateGridValues(rst, Grd.SelectedItem.Text = "G")
If Grd.SelectedItem.Text = "A" Then
Call DisplayAccountStatus(Grd.SelectedItem.ListSubItems("ACCODE").Text)
End If
ElseIf KeyCode = vbKeyEscape Then
If Grd.SelectedItem.ListSubItems("GRCODE").Text = "" Then
Unload Me
Exit Sub
End If
SQL = "SELECT * FROM ACMAST WHERE ACCODE = '" & Grd.SelectedItem.ListSubItems("GRCODE").Text & "' ORDER BY ACMAST.ACDESC"
rst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rst.AbsolutePosition > 0 Then GR = IIf(IsNull(rst!GrCode), "", rst!GrCode)
If GR <> "" Then
'If Grd.ColumnHeaders(1).Text = "G/A" Then
If Not OneStepBack Then
SQL = "SELECT ACMAST.MODIFY, ACMAST.ACCODE, ACMAST.ACDESC, ACMAST.ACALIAS, ACMAST.RECTYPE, ACMAST.CASH, ACMAST.GRCODE, ACMAST.ACTYPE, ACMAST.[Level], ACMAST.BSHEET, AcTrans.CLOSING, AcTrans.YOBDR, AcTrans.YOBCR " & _
"FROM ACMAST INNER JOIN AcTrans ON ACMAST.ACCODE = AcTrans.Accode WHERE ACMAST.GRCODE = '" & GR & "' ORDER BY ACMAST.ACDESC"
ElseIf OneStepBack Then
SQL = "SELECT ACMAST.MODIFY, ACMAST.ACCODE, ACMAST.ACDESC, ACMAST.ACALIAS, ACMAST.RECTYPE, ACMAST.CASH, ACMAST.GRCODE, ACMAST.ACTYPE, ACMAST.[Level], ACMAST.BSHEET, AcTrans.CLOSING, AcTrans.YOBDR, AcTrans.YOBCR " & _
"FROM ACMAST INNER JOIN AcTrans ON ACMAST.ACCODE = AcTrans.Accode WHERE ACMAST.GRCODE = '" & Grd.SelectedItem.ListSubItems("GRCODE").Text & "' ORDER BY ACMAST.ACDESC"
OneStepBack = False
End If
If rst.State = adStateOpen Then rst.Close
rst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
Call PopulateGridValues(rst)
Call DisplayAccountStatus(IIf(Grd.SelectedItem.Text = "A", Grd.SelectedItem.ListSubItems("ACCODE").Text, ""))
If Grd.SelectedItem.Text = "A" Then Call DisplayAccountStatus(Grd.SelectedItem.ListSubItems("ACCODE").Text)
If rst.RecordCount > 0 Then Call SetGridFormat(Not IsDate(Grd.SelectedItem.Text))
Else
Call SetGridValues
End If
Grd.SetFocus
If LastRow <= Grd.ListItems.Count Then Grd.ListItems(LastRow).Selected = True
End If
End Sub
Private Sub DisplayAccountStatus(Optional AcCode As String)
If AcCode = "" Then
OpeningLbl = ""
ClosingLbl = ""
OpeningAmtLbl = ""
ClosingAmtLbl = ""
AccountLbl = ""
AcLbl = ""
Exit Sub
End If
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
Dim OpeiningAmt As Double
Dim DrCr As String
Dim SQL As String
SQL = "SELECT AcTrans.Accode, ACMAST.ACDESC, AcTrans.CLOSING, AcTrans.YOBDR, AcTrans.YOBCR, AcTrans.Cr_Dr " & _
"FROM ACMAST INNER JOIN AcTrans ON ACMAST.ACCODE = AcTrans.Accode Where AcTrans.ACCODE = '" & AcCode & "'"
rst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
ClosingAmtLbl = IIf(rst.AbsolutePosition > 0, Abs(rst!CLOSING), NumFormat)
ClosingAmtLbl = Format(ClosingAmtLbl, NumFormat)
If Val(ClosingAmtLbl) <> 0 Then
ClosingAmtLbl = ClosingAmtLbl & " " & IIf(rst!CLOSING > 0, "Dr", "Cr")
End If
OpeiningAmt = IIf(IsNull(rst!YOBDR), 0, rst!YOBDR)
If OpeiningAmt > 0 Then DrCr = " Dr"
If OpeiningAmt = 0 Then
ClosingAmt = IIf(IsNull(rst!YOBCR), 0, rst!YOBCR)
DrCr = " Cr"
End If
If OpeiningAmt = 0 Then DrCr = ""
OpeningAmtLbl = Format(Abs(OpeiningAmt), NumFormat) & "" & DrCr
OpeningLbl = "Opening Balance :"
ClosingLbl = "Closing Balance :"
AccountLbl = "Account :"
AcLbl = IIf(IsNull(rst!AcDESC), "", rst!AcDESC)
End Sub
Private Sub Grd_ItemClick(ByVal Item As MSComctlLib.ListItem)
If Item.Text = "A" Then
'MsgBox Item.ListSubItems("ACDESC") & " " & Item.Text
Call DisplayAccountStatus(Item.ListSubItems("ACCODE").Text)
ElseIf Item.Text = "G" Then
Call DisplayAccountStatus
End If
End Sub