Due to some technical error All Project source code & Project report are now available on www.ignousupport.blogspot.com Download all project for free
Cash Book
''******************************************************************
'******************************************************************
'** Author : Samee Ullah Siddiqui
'** Subject : Creating Cash Book
'** Date : Thursday, December, 11, 2003
'** Modified : Friday, December, 12, 2003
'******************************************************************
'******************************************************************
Option Explicit
Dim Bal As Double
Dim TerminateLoop As Boolean
Private Sub CancelCmd_Click()
Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then SendKeys "{TAB}"
End Sub
Private Sub Form_Load()
Dt1.Value = Date
Dt2.Value = Date
End Sub
Private Sub OKCmd_Click()
Dim SQL As String
On Error GoTo ErHand
If OKCmd.Caption = "&OK" Then
If (Dt1.Value = "" Or (Not IsDate(Dt1.Value))) Then
MsgBox "Please enter a valid From date to view/print CASH BOOK", vbCritical, "Invalid Date"
Dt1.SetFocus
Exit Sub
ElseIf (Dt2.Value = "" Or (Not IsDate(Dt2.Value))) Then
MsgBox "Please enter a valid To date to view/print CASH BOOK", vbCritical, "Invalid Date"
Dt2.SetFocus
Exit Sub
End If
If CDate(Dt1.Value) > CDate(Dt2.Value) Then
MsgBox "To Date must greater then or equal to From Date", vbCritical, "Value Error..."
Exit Sub
End If
If DE.CashBKConn.State = adStateOpen Then DE.CashBKConn.Close
DE.CashBKConn.Open ShapeConnectString
Dim CycleDate As Date
Dim i, V As Long
V = CDate(Dt2.Value) - CDate(Dt1.Value)
If V > 0 Then PB.Max = V
PB.Visible = True
DE.CashBKConn.BeginTrans
DE.CashBKConn.Execute "DELETE FROM CASHBOOK_TEMP"
Dim OpRst As New ADODB.Recordset
OpRst.CursorLocation = adUseClient
'Get Opening Amount of Cash In Hand from ACTRANS table
Bal = 0
SQL = "SELECT * FROM ACTRANS WHERE ACCODE = '000030'"
OpRst.Open SQL, DE.CashBKConn, adOpenForwardOnly, adLockReadOnly, adCmdText
Bal = IIf(IsNull(OpRst!YOBDR), 0, OpRst!YOBDR)
If Bal = 0 Then Bal = IIf(IsNull(OpRst!YOBCR), 0, -OpRst!YOBCR)
OpRst.Close
'Get Opening Amount of Cash In Hand from VOUCHER table
SQL = "SELECT SUM(DRAMT) AS DEBITAMT, SUM(CRAMT) AS CREDITAMT, SUM(DRAMT)-SUM(CRAMT) AS OPAMT FROM VOUCHER WHERE ACCODE = '000030' AND VDATE < '" & Dt1.Value & "'"
OpRst.Open SQL, DE.CashBKConn, adOpenForwardOnly, adLockReadOnly, adCmdText
Bal = Bal + IIf(IsNull(OpRst!OPAMT), 0, OpRst!OPAMT)
OKCmd.Caption = "&Abort"
CancelCmd.Enabled = False
TerminateLoop = False
Screen.MousePointer = vbHourglass
For CycleDate = Dt1.Value To Dt2.Value
If PrepairCashBook(CycleDate, DE.CashBKConn) Then
DoEvents
PB.Value = i
i = i + 1
Label2(2).Caption = "Preparing of " & Format(CycleDate, "dd/mm/yy")
If TerminateLoop Then
OKCmd.Caption = "&OK"
CancelCmd.Enabled = True
Screen.MousePointer = vbDefault
PB.Visible = False
Label2(2).Caption = ""
DE.CashBKConn.CommitTrans
Exit Sub
End If
End If
Next CycleDate
Screen.MousePointer = vbDefault
OKCmd.Caption = "&OK"
CancelCmd.Enabled = True
PB.Visible = False
Label2(2).Caption = ""
DE.CashBKConn.CommitTrans
SQL = "SHAPE {SELECT * FROM CASHBOOK_TEMP;} AS CashBKCmd COMPUTE CashBKCmd, SUM(CashBKCmd.'CrAmt') AS CrTotal, SUM(CashBKCmd.'DrAmt') AS DrTotal BY 'VDATE'"
If DE.rsCashBKCmd_Grouping.State = adStateOpen Then DE.rsCashBKCmd_Grouping.Close
DE.rsCashBKCmd_Grouping.Open SQL, DE.CashBKConn, adOpenForwardOnly, adLockReadOnly, adCmdText
Set CashBKRpt.DataSource = DE
With CashBKRpt
.Sections("DayBKCmd_Detail").Controls("txtDrNarr").Top = IIf(NarrChk.Value = vbChecked, 240, 0)
.Sections("DayBKCmd_Detail").Controls("txtDrNarr").Visible = NarrChk.Value = vbChecked
.Sections("DayBKCmd_Detail").Controls("txtCrNarr").Top = IIf(NarrChk.Value = vbChecked, 240, 0)
.Sections("DayBKCmd_Detail").Controls("txtCrNarr").Visible = NarrChk.Value = vbChecked
.Sections("DayBKCmd_Detail").Controls("Shape7").Height = IIf(NarrChk.Value = vbChecked, 480, 240)
.Sections("DayBKCmd_Detail").Controls("Shape8").Height = IIf(NarrChk.Value = vbChecked, 480, 240)
.Sections("DayBKCmd_Detail").Controls("Shape9").Height = IIf(NarrChk.Value = vbChecked, 480, 240)
.Sections("DayBKCmd_Detail").Height = IIf(NarrChk.Value = vbChecked, 480, 240)
End With
Unload Me
If Option1(0).Value Then
CashBKRpt.Show
Else
CashBKRpt.PrintReport
End If
Else
TerminateLoop = True
End If
Exit Sub
ErHand:
ErrHandler "CashBook.OkCmd_Click()"
OKCmd.Caption = "&OK"
CancelCmd.Enabled = True
Screen.MousePointer = vbDefault
PB.Visible = False
Label2(2).Caption = ""
DE.CashBKConn.RollbackTrans
End Sub
Private Function PrepairCashBook(ByVal DayDt As Date, ByVal Conn As ADODB.Connection) As Boolean
Dim SQL As String
Dim i As Double
Dim CrRSt As New ADODB.Recordset
CrRSt.CursorLocation = adUseClient
Dim DrRSt As New ADODB.Recordset
DrRSt.CursorLocation = adUseClient
'Open Crdit Recordset
SQL = "SELECT VOUCHER.SNO, VOUCHER.VTYPE, VOUCHER.VNO, VOUCHER.VDATE, VOUCHER.ACCODE, VOUCHER.ACCONTRA, VOUCHER.DRAMT, VOUCHER.CRAMT, VOUCHER.DRCR, ACMAST.ACDESC, coalesce('(' + Voucher.NARR + ')','') AS NARRATION " & _
"FROM VOUCHER INNER JOIN ACMAST ON VOUCHER.ACCODE = ACMAST.ACCODE WHERE VTYPE + VNO IN( SELECT VTYPE + VNO FROM VOUCHER WHERE ACCODE = '000030') AND VOUCHER.VDATE = '" & DayDt & "' AND VOUCHER.DRCR = 'C'"
CrRSt.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
'Open Debit Recordset
SQL = "SELECT VOUCHER.SNO, VOUCHER.VTYPE, VOUCHER.VNO, VOUCHER.VDATE, VOUCHER.ACCODE, VOUCHER.ACCONTRA, VOUCHER.DRAMT, VOUCHER.CRAMT, VOUCHER.DRCR, ACMAST.ACDESC,coalesce('(' + Voucher.NARR + ')','') AS NARRATION " & _
"FROM VOUCHER INNER JOIN ACMAST ON VOUCHER.ACCODE = ACMAST.ACCODE WHERE VTYPE + VNO IN( SELECT VTYPE + VNO FROM VOUCHER WHERE ACCODE = '000030') AND VOUCHER.VDATE = '" & DayDt & "' AND VOUCHER.DRCR = 'D'"
DrRSt.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
Dim TmpRst As New ADODB.Recordset
TmpRst.CursorLocation = adUseClient
TmpRst.Open "SELECT * FROM CASHBOOK_TEMP WHERE VDATE = '" & DayDt & "'", Conn, adOpenKeyset, adLockOptimistic, adCmdText
'Add a ROW for Cash In Hand (Opening)
TmpRst.AddNew
TmpRst!sno = TmpRst.RecordCount
TmpRst!vDate = DayDt
If Bal >= 0 Then
TmpRst!CRCode = "OP"
TmpRst!CrAmt = Bal
TmpRst!CRDESC = "By Opening Cash"
ElseIf Bal < 0 Then
TmpRst!DRCode = "OP"
TmpRst!DrAmt = Bal
TmpRst!DRDESC = "To Opening Cash"
End If
TmpRst.Update
Do Until DrRSt.EOF And CrRSt.EOF
SetCrValue:
If Not CrRSt.EOF Then
If CrRSt!AcCode <> "000030" Then 'Expect Cash In Hand
TmpRst.AddNew
TmpRst!sno = TmpRst.RecordCount
TmpRst!vDate = CrRSt!vDate
TmpRst!CRCode = CrRSt!AcCode
TmpRst!CRDESC = "By " & CrRSt!AcDESC
TmpRst!CrAmt = CrRSt!CrAmt
TmpRst!CRNARR = CrRSt!NARRATION
Else
Bal = Bal - IIf(IsNull(CrRSt!CrAmt), 0, CrRSt!CrAmt)
If Not CrRSt.EOF Then CrRSt.MoveNext
GoTo SetCrValue
End If
End If
DoEvents
SetDrValue:
If Not DrRSt.EOF Then
If DrRSt.AbsolutePosition > CrRSt.RecordCount Then TmpRst.AddNew
If DrRSt!AcCode <> "000030" Then 'Expect Cash In Hand
If Not IsNull(TmpRst!DRCode) Then TmpRst.AddNew
If IsNull(TmpRst!vDate) Then TmpRst!vDate = DrRSt!vDate
TmpRst!DRCode = DrRSt!AcCode
TmpRst!DRDESC = "To " & DrRSt!AcDESC
TmpRst!DrAmt = IIf(DrRSt!DrAmt = 0, Null, DrRSt!DrAmt)
TmpRst!DRNARR = DrRSt!NARRATION
Else
Bal = Bal + IIf(IsNull(DrRSt!DrAmt), 0, DrRSt!DrAmt)
If Not DrRSt.EOF Then DrRSt.MoveNext
GoTo SetDrValue
End If
End If
TmpRst.Update
If Not CrRSt.EOF Then CrRSt.MoveNext
If Not DrRSt.EOF Then DrRSt.MoveNext
Loop
'Add a ROW for Cash In Hand (Closing)
TmpRst.AddNew
TmpRst!sno = TmpRst.RecordCount
TmpRst!vDate = DayDt
If Bal >= 0 Then
TmpRst!DRCode = "CL"
TmpRst!DrAmt = Bal
TmpRst!DRDESC = "To Closing Cash"
ElseIf Bal < 0 Then
TmpRst!CRCode = "CL"
TmpRst!CrAmt = Bal
TmpRst!CRDESC = "By Closing Cash"
End If
TmpRst.Update
PrepairCashBook = True
End Function
Sponsored Links
This site is designed to help BCA MCA student to develop final project and synopsis Download Free BCA Project, MCA Project, IT Projects, Final report and Project synopsis with Full documentation and code