Next Chapter 61 Trial Balance

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