Due to some technical error All Project source code & Project report are now available on www.ignousupport.blogspot.com Download all project for free
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