Next Chapter 37 Financial Ledger

PROJECT SOURCE CODE

SPONSORED LINKS

Financial Ledger

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

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

'** Author : Samee Ullah Siddiqui

'** Subject : Financial Ledger Report

'** Date : Monday, November, 10, 2003

'** Modified : Monday, November, 10, 2003

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

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

Dim TerminateLoop As Boolean

Private Sub AcHdChk_Click()

If AcHdChk = vbUnchecked Then

NarrChk.Value = vbChecked

End If

End Sub

Private Sub Allcmd_Click()

Call SelectListItem(AcList, SelectAll)

End Sub

Private Sub CancelCmd_Click()

Unload Me

End Sub

Private Sub Form_Load()

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

DE.FinLedConn.Open ShapeConnectString

Date1.Value = SelectedCompany.FromDate

Date2.Value = Date

Call FillGroups

GrpCB.ListIndex = 0

End Sub

Private Sub Form_Unload(Cancel As Integer)

On Error Resume Next

End Sub

Private Sub GrpCB_Click()

Dim GrCode As String

If Not (GrpCB.ListIndex >= 0) Then Exit Sub

GrCode = GetProperCode(GrpCB.ItemData(GrpCB.ListIndex), 6)

Call FillAccounts(GrCode)

End Sub

Private Sub NarrChk_Click()

If NarrChk = vbUnchecked Then

AcHdChk.Value = vbChecked

End If

End Sub

Private Sub OKCmd_Click()

Dim i, G As Integer

Dim GroupCode, SQL As String

If OKCmd.Caption = "OK" Then

If Not AcList.SelCount > 0 Then

MsgBox "Please Select the Accounts from Account List to view or print Financial Ledger.", vbExclamation, "Accounts not selected"

Exit Sub

End If

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

DE.FinLedConn.mode = adModeReadWrite

DE.FinLedConn.Open ShapeConnectString

DE.FinLedConn.BeginTrans

'Erase Old record in Temporary Table

DE.FinLedConn.Execute "DELETE FROM FIN_LEDGER_TEMP", , adCmdText

PB.Visible = True

PB.Max = AcList.ListCount

OKCmd.Caption = "Abort"

TerminateLoop = False

Screen.MousePointer = vbHourglass

For i = 0 To AcList.ListCount - 1

DoEvents

PB.Value = i

If AcList.Selected(i) Then

G = AcList.ItemData(i)

GroupCode = GetProperCode(G, 6)

Call PrepareFincialLedgerData(GroupCode)

End If

If TerminateLoop Then

PB.Visible = False

DE.FinLedConn.RollbackTrans

Screen.MousePointer = vbDefault

OKCmd.Caption = "OK"

Exit Sub

End If

Next i

PB.Visible = False

OKCmd.Caption = "OK"

Screen.MousePointer = vbDefault

DE.FinLedConn.CommitTrans

SQL = "SHAPE {SELECT FIN_LEDGER_TEMP.ACCODE, AC.ACDESC, FIN_LEDGER_TEMP.ACCONTRA, case when FIN_LEDGER_TEMP.ACCONTRA='OP' then 'Opening Balance' else ACON.ACDESC end AS ACONTRADESC, FIN_LEDGER_TEMP.VDATE, FIN_LEDGER_TEMP.DEBIT, FIN_LEDGER_TEMP.CREDIT, FIN_LEDGER_TEMP.BALANCE, FIN_LEDGER_TEMP.NARR " & _

"FROM (FIN_LEDGER_TEMP INNER JOIN ACMAST AS AC ON FIN_LEDGER_TEMP.ACCODE = AC.ACCODE ) LEFT JOIN ACMAST AS ACON ON FIN_LEDGER_TEMP.ACCONTRA = ACON.ACCODE ORDER BY SNO,VDATE} AS FinLedCmd COMPUTE FinLedCmd, SUM(FinLedCmd.'DEBIT') AS DebitTotal, SUM(FinLedCmd.'CREDIT') AS CreditTotal BY 'ACDESC'"

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

DE.rsFinLedCmd_Grouping.Open SQL, DE.FinLedConn, adOpenForwardOnly, adLockReadOnly, adCmdText

Set FinLdrRpt.DataSource = DE

With FinLdrRpt

.Sections("FinLedCmd_Grouping_Header").Controls("DtLbl").Caption = "Period From: " & Format(Date1.Value, "dd-mm-yyyy") & " To: " & Format(Date2.Value, "dd-mm-yyyy")

.Sections("FinLedCmd_Detail").Controls("txtNARR").Visible = NarrChk.Value = vbChecked

.Sections("FinLedCmd_Detail").Controls("txtNARR").Top = IIf((NarrChk.Value = vbUnchecked) Or (AcHdChk.Value = vbUnchecked), 0, 285)

.Sections("FinLedCmd_Detail").Controls("txtACONTRADESC").Visible = AcHdChk.Value = vbChecked

.Sections("FinLedCmd_Detail").Height = IIf((NarrChk.Value = vbUnchecked) Or (AcHdChk.Value = vbUnchecked), 240, 531)

End With

On Error GoTo ErHand

If Option1(0).Value Then

FinLdrRpt.Show

Else

FinLdrRpt.PrintReport

End If

Else

TerminateLoop = True

End If

ErHand:

ErrHandler "FinLgrFrm.CmdPrint"

End Sub

Private Sub Nonecmd_Click()

Call SelectListItem(AcList, SelectNone)

End Sub

Private Sub FillGroups()

Dim rst As New ADODB.Recordset

rst.CursorLocation = adUseClient

rst.Open "SELECT * FROM ACMAST WHERE RECTYPE ='G' ORDER BY ACMAST.ACDESC", DE.FinLedConn, adOpenForwardOnly, adLockReadOnly, adCmdText

GrpCB.Clear

GrpCB.AddItem "(All)"

Do Until rst.EOF

GrpCB.AddItem rst!AcDESC

GrpCB.ItemData(GrpCB.NewIndex) = rst!AcCode

rst.MoveNext

Loop

End Sub

Private Sub FillAccounts(ByVal vAccode As String)

If vAccode = "" And GrpCB.ListIndex > 0 Then

Exit Sub

End If

Dim rst As New ADODB.Recordset

rst.CursorLocation = adUseClient

If GrpCB.ListIndex = 0 Then

rst.Open "SELECT * FROM ACMAST WHERE RECTYPE ='A' ORDER BY ACMAST.ACDESC", DE.FinLedConn, adOpenForwardOnly, adLockReadOnly, adCmdText

Else

rst.Open "SELECT * FROM ACMAST WHERE RECTYPE ='A' AND GRCODE ='" & vAccode & "' ORDER BY ACMAST.ACDESC", DE.FinLedConn, adOpenForwardOnly, adLockReadOnly, adCmdText

End If

AcList.Clear

Do Until rst.EOF

AcList.AddItem rst!AcDESC

AcList.ItemData(AcList.NewIndex) = rst!AcCode

rst.MoveNext

Loop

End Sub

Private Sub ReserveCmd_Click()

Call SelectListItem(AcList, SelectReverse)

End Sub

Private Function PrepareFincialLedgerData(ByVal vAcode As String)

Dim SQL As String

Dim Bal As Double

Dim rst As New ADODB.Recordset

rst.CursorLocation = adUseClient

'Get Opening Amount of Account from ACTRANS table

Set rst = New ADODB.Recordset

SQL = "SELECT * FROM ACTRANS WHERE ACCODE = '" & vAcode & "'"

rst.Open SQL, DE.FinLedConn, adOpenForwardOnly, adLockReadOnly, adCmdText

If Not rst.EOF Then Bal = IIf((rst!YOBDR), 0, rst!YOBDR) Else Bal = 0

If Not rst.EOF Then Bal = IIf((rst!YOBCR), 0, rst!YOBCR) Else Bal = 0

rst.Close

'Getting Openin Balance

SQL = "SELECT SUM(DRAMT) AS DEBITAMT, SUM(CRAMT) AS CREDITAMT, SUM(DRAMT)-SUM(CRAMT) AS OPAMT FROM VOUCHER WHERE ACCODE = '" & vAcode & "' AND VDATE < '" & Date1.Value & "'"

rst.Open SQL, DE.FinLedConn, adOpenForwardOnly, adLockReadOnly, adCmdText

Bal = Bal + IIf(IsNull(rst!OPAMT), 0, rst!OPAMT)

rst.Close

'Sending One entry of Opening Amount

If Bal <> 0 Then

SQL = "INSERT INTO FIN_LEDGER_TEMP VALUES (" & 1 & ", '" & vAcode & "', 'OP', Null, " & IIf(Bal > 0, Abs(Bal), 0) & ", " & IIf(Bal < 0, Abs(Bal), 0) & ", '" & Format(Bal, "0.00") & IIf(Bal < 0, "Cr", "Dr") & "','')"

DE.FinLedConn.Execute SQL

End If

SQL = "SELECT * FROM VOUCHER WHERE ACCODE = '" & vAcode & "' AND (VDATE BETWEEN '" & Date1.Value & "' AND '" & Date2.Value & "') ORDER BY SNO,VDATE"

rst.Open SQL, DE.FinLedConn, adOpenForwardOnly, adLockReadOnly, adCmdText

Do Until rst.EOF Or TerminateLoop

Bal = (Bal + IIf(IsNull(rst!DrAmt), 0, rst!DrAmt)) - IIf(IsNull(rst!CrAmt), 0, rst!CrAmt)

SQL = "INSERT INTO FIN_LEDGER_TEMP VALUES (" & rst!sno & ", '" & vAcode & "', '" & rst!ACContra & "', '" & rst!vDate & "', " & rst!DrAmt & ", " & rst!CrAmt & ", '" & Format(Abs(Bal), "0.00") & rst!DrCr & "r" & "', '" & rst!NARR & "')"

DE.FinLedConn.Execute SQL

rst.MoveNext

Loop

End Function