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
Trial Balance
'******************************************************************
'******************************************************************
'** Author : Samee Ullah Siddiqui
'** Subject : Trial Balance Report
'** Date : Saturday, November, 08, 2003
'** Modified : Monday, November, 10, 2003
'******************************************************************
'******************************************************************
Dim SQL As String
Private Sub CancelCmd_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dt.Value = Date
End Sub
Private Sub OKCmd_Click()
If Dt.Value = "" Or (Not IsDate(Dt.Value)) Then
Unload Me
Exit Sub
End If
If DE.TrialBalConn.State = adStateOpen Then DE.TrialBalConn.Close
DE.TrialBalConn.Open ConnectString
If PrepairTrialBalance(Dt.Value, DE.TrialBalConn) Then
Set TrialBalRpt.DataSource = DE
TrialBalRpt.Sections("ReportHeader").Controls("DtLbl").Caption = "Trial Balance as on " & Format(Dt.Value, "dd/mm/yyyy")
Unload Me
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
' SQL = "SELECT ACMAST.ACCODE, ACMAST.ACDESC, Iif(AcTrans.BALANCE >0,AcTrans.BALANCE, NULL) AS Debit,IIf(AcTrans.BALANCE <0,Abs(AcTrans.BALANCE), NULL) AS Credit " & _
' "FROM ACMAST INNER JOIN AcTrans ON ACMAST.ACCODE = AcTrans.Accode Where RecType = 'A' AND AcTrans.BALANCE <> 0 ORDER BY ACMAST.ACDESC"
SQL = " SELECT ACMAST.ACCODE, ACMAST.ACDESC, " & _
" CASE WHEN AcTrans.BALANCE > 0 THEN ABS(AcTrans.BALANCE)ELSE NULL END AS Debit, " & _
" CASE WHEN AcTrans.BALANCE < 0 THEN Abs(AcTrans.BALANCE) ELSE NULL END AS Credit " & _
" From ACMAST, ACTrans " & _
" Where ACMAST.AcCode = ACTrans.AcCode AND RecType = 'A' " & _
" AND AcTrans.BALANCE <> 0 ORDER BY ACMAST.ACDESC "
If DE.rsTrialBalCmd.State = adStateOpen Then DE.rsTrialBalCmd.Close
DE.rsTrialBalCmd.Open SQL, DE.TrialBalConn, adOpenForwardOnly, adLockReadOnly, adCmdText
SQL = " SELECT Sum(CASE WHEN AcTrans.BALANCE >0 THEN AcTrans.BALANCE ELSE 0 END ) AS SumOfDEBIT, " & _
" Sum(CASE WHEN AcTrans.BALANCE <0 THEN Abs(AcTrans.BALANCE) ELSE 0 END) AS SumOfCREDIT " & _
" FROM ACMAST INNER JOIN AcTrans ON ACMAST.ACCODE = AcTrans.Accode WHERE ACMAST.RECTYPE='A'"
rst.Open SQL, DE.TrialBalConn, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not rst.RecordCount > 0 Then
MsgBox "Account transaction not available.", vbCritical, "Opening Trial"
Exit Sub
End If
DrTotal = IIf(IsNull(rst!SumOfDEBIT), 0, rst!SumOfDEBIT)
CrTotal = IIf(IsNull(rst!SumOfCREDIT), 0, rst!SumOfCREDIT)
Diff = Abs(DrTotal - CrTotal)
TrialBalRpt.Sections("ReportFooter").Controls("DiffDebitLbl").Caption = Format(IIf(DrTotal < CrTotal, Diff, ""), "0.00")
TrialBalRpt.Sections("ReportFooter").Controls("DiffCreditLbl").Caption = Format(IIf(CrTotal < DrTotal, Diff, ""), "0.00")
If Val(TrialBalRpt.Sections("ReportFooter").Controls("DiffCreditLbl").Caption) = Val(TrialBalRpt.Sections("ReportFooter").Controls("DiffDebitLbl").Caption) Then
TrialBalRpt.Sections("ReportFooter").Controls("DiffLbl").Caption = ""
TrialBalRpt.Sections("ReportFooter").Controls("DiffDebitLbl").Caption = ""
TrialBalRpt.Sections("ReportFooter").Controls("DiffCreditLbl").Caption = ""
Else
TrialBalRpt.Sections("ReportFooter").Controls("DiffLbl").Caption = "Difference in Opening :"
End If
TrialBalRpt.Sections("ReportFooter").Controls("DebitLbl").Caption = Format(DrTotal + Val(TrialBalRpt.Sections("ReportFooter").Controls("DiffDebitLbl").Caption), "0.00")
TrialBalRpt.Sections("ReportFooter").Controls("CreditLbl").Caption = Format(CrTotal + Val(TrialBalRpt.Sections("ReportFooter").Controls("DiffCreditLbl").Caption), "0.00")
If Option1(0).Value Then
TrialBalRpt.Show
Else
TrialBalRpt.PrintReport
End If
End If
End Sub
Private Function PrepairTrialBalance(ByVal TrialDt As Date, ByVal Conn As ADODB.Connection) As Boolean
Dim SQL, mAccode As String
Dim i As Integer
Dim ACRst As New ADODB.Recordset
ACRst.CursorLocation = adUseClient
SQL = "Select * From ACMAST ORDER BY ACCODE"
ACRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
If Not (ACRst.RecordCount > 0) Then
MsgBox "ACMAST Table having no records.", vbCritical, "Table blank"
Exit Function
End If
Dim vRst As New ADODB.Recordset
vRst.CursorLocation = adUseClient
SQL = "Select * From VOUCHER WHERE VDATE <= '" & TrialDt & "'"
vRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
If Not (vRst.RecordCount > 0) Then
MsgBox "There is no transaction up to specified date.", vbCritical, "No Transaction"
Exit Function
End If
Dim AcTransRst As New ADODB.Recordset
'AcTransRst.CursorLocation = adUseServer
SQL = "Select * From AcTrans ORDER BY ACCODE"
AcTransRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
If AcTransRst.EOF Then
MsgBox "AcTrans Table having no records.", vbCritical, "Table blank"
Dt.SetFocus
Exit Function
End If
SQL = "UPDATE ACTRANS SET BALANCE = 0"
Conn.Execute SQL, i, adCmdText
Screen.MousePointer = vbHourglass
PB.Visible = True
PB.Max = vRst.RecordCount
Do Until vRst.EOF
mAccode = vRst!AcCode
Do
AcTransRst.MoveFirst
AcTransRst.Find "ACCODE = '" & mAccode & "'"
If AcTransRst.EOF Then
MsgBox "Account Code [" & mAccode & "] is not found in ACTrans Table.", vbCritical, "Record not found"
Exit Function
Else
SQL = "UPDATE ACTRANS SET BALANCE = (BALANCE + " & IIf(vRst!DrCr = "D", vRst!DrAmt, -vRst!CrAmt) & ") Where ACCODE = '" & mAccode & "'"
SQL = VBA.Replace(SQL, "--", "+")
Conn.Execute SQL, i, adCmdText
If i = 0 Then MsgBox "Posting Amount for Accound Code [" & mAccode & "] could not update in ACTRANS Table", vbCritical, "Unsuccessfull Updatation"
i = 0
End If
ACRst.MoveFirst
ACRst.Find "ACCODE = '" & mAccode & "'"
If ACRst.EOF Then
MsgBox "Account Code [" & mAccode & "] is not found in ACMAST Table.", vbCritical, "Record not found"
Exit Function
Else
If IsNull(ACRst!GrCode) Or ACRst!GrCode = "" Then
Exit Do
Else
mAccode = ACRst!GrCode
End If
End If
Loop
PB.Value = vRst.AbsolutePosition
vRst.MoveNext
Loop
PB.Visible = False
Screen.MousePointer = vbDefault
PrepairTrialBalance = True
End Function