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
Day Book
'******************************************************************
'******************************************************************
'** Author : Samee Ullah Siddiqui
'** Subject : Creating Day Book
'** Date : Saturday, December, 06, 2003
'** Modified : Thursday, December, 11, 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 DAY 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 DAY 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.DayBKConn.State = adStateOpen Then DE.DayBKConn.Close
DE.DayBKConn.Open ShapeConnectString
Dim CycleDate As Date
Dim i, V As Long
V = CDate(DayBKFrm.Dt2.Value) - CDate(DayBKFrm.Dt1.Value)
If V > 0 Then PB.Max = V
PB.Visible = True
DE.DayBKConn.BeginTrans
DE.DayBKConn.Execute "DELETE FROM DAYBOOK_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.DayBKConn, 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.DayBKConn, 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 PrepairDayBook(CycleDate, DE.DayBKConn) Then
DoEvents
Label2(2).Caption = "Preparing of " & Format(CycleDate, "dd/mm/yy")
PB.Value = i
i = i + 1
If TerminateLoop Then
OKCmd.Caption = "&OK"
CancelCmd.Enabled = True
Screen.MousePointer = vbDefault
PB.Visible = False
Label2(2).Caption = ""
DE.DayBKConn.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.DayBKConn.CommitTrans
SQL = "SHAPE {SELECT * FROM DAYBOOK_TEMP;} AS DayBKCmd COMPUTE DayBKCmd, SUM(DayBKCmd.'CrAmt') AS CrTotal, SUM(DayBKCmd.'DrAmt') AS DrTotal BY 'VDATE'"
If DE.rsDayBKCmd_Grouping.State = adStateOpen Then DE.rsDayBKCmd_Grouping.Close
DE.rsDayBKCmd_Grouping.Open SQL, DE.DayBKConn, adOpenForwardOnly, adLockReadOnly, adCmdText
Set DayBKRpt.DataSource = DE
With DayBKRpt
.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
DayBKRpt.Show
Else
DayBKRpt.PrintReport
End If
Else
TerminateLoop = True
End If
Exit Sub
ErHand:
ErrHandler "DayBook.OkCmd_Click()"
DE.DayBKConn.RollbackTrans
End Sub
Private Function PrepairDayBook(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.ACCODE, Voucher.VDATE, ACMAST.ACDESC, Voucher.DRAMT, Voucher.CRAMT, Voucher.DRCR, COALESCE('(' + Voucher.NARR + ')','') AS NARRATION " & _
"FROM Voucher INNER JOIN ACMAST ON Voucher.ACCODE = ACMAST.ACCODE WHERE VDATE = '" & DayDt & "' AND DRCR = 'C'"
CrRSt.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
'Open Debit Recordset
SQL = "SELECT Voucher.ACCODE, Voucher.VDATE, ACMAST.ACDESC, Voucher.DRAMT, Voucher.CRAMT, Voucher.DRCR, COALESCE('(' + Voucher.NARR + ')','') AS NARRATION " & _
"FROM Voucher INNER JOIN ACMAST ON Voucher.ACCODE = ACMAST.ACCODE WHERE VDATE = '" & DayDt & "' AND DRCR = 'D'"
DrRSt.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
Dim TmpRst As New ADODB.Recordset
TmpRst.CursorLocation = adUseClient
TmpRst.Open "SELECT * FROM DAYBOOK_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
PrepairDayBook = True
End Function
Next Chapter 33 Department Form
Sponsored Links