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

Next Chapter 26 Bill Master