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
Purchase Register
'******************************************************************
'******************************************************************
'** Author : Samee Ullah Siddiqui
'** Subject : Creating Purchase Register
'** Date : Monday, September, 08, 2003
'** Modified : Monday, September, 08, 2003
'******************************************************************
'******************************************************************
Private Sub CancelCmd_Click()
Unload Me
End Sub
Private Sub chkSuplWise_Click()
txtSupl.Enabled = (chkSuplWise.Value = vbChecked)
End Sub
Private Sub cmbCashCredit_Click()
chkSuplWise.Enabled = (cmbCashCredit.ListIndex = 1)
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Me.ActiveControl.Name = "txtSupl" Then Exit Sub
If Not KeyCode = vbKeyReturn Then Exit Sub
SendKeys "{TAB}"
End Sub
Private Sub Form_Load()
DtFrom = SelectedCompany.FromDate
DtTo = Date
'DEFAULT VALUE - ALL
cmbCashCredit.ListIndex = 2
cmbPrch_return.ListIndex = 0
With SuplSrch
.DBConnectString = ConnectString
.SQLString = "SELECT ACCode, ACDESC FROM ACMAST WHERE RECTYPE = 'A' AND CASH = 'P'"
Set .BoundTextBox = txtSupl
.PopulateList
End With
End Sub
Private Sub OKCmd_Click()
On Error GoTo ErHand
Dim SQL, SuplType, PrchOrPrchReturn, SuplCode As String
Dim NetValue As Double
If (chkSuplWise.Value = vbChecked And cmbCashCredit.Text = "Credit") And txtSupl.Tag = "" Then MsgBox "Please select party from Supplier Name list.", vbCritical, "Missing Value": Exit Sub
'Decide Party Type
If cmbCashCredit.Text = "Cash" Then
SuplType = " AND (LEFT(PURCHASE.VNO,1) ='C')"
ElseIf cmbCashCredit.Text = "Credit" Then
SuplType = " AND (LEFT(PURCHASE.VNO,1) ='R')"
Else
SuplType = ""
End If
'Decide Sale Return
If cmbPrch_return.Text = "Purchase" Then
PrchOrPrchReturn = " AND (PURCHASE.VTYPE='PV')"
ElseIf cmbPrch_return.Text = "Purchase Return" Then
PrchOrPrchReturn = " AND (PURCHASE.VTYPE='PR')"
Else
PrchOrPrchReturn = ""
End If
SuplCode = IIf(chkSuplWise.Value = vbChecked And cmbCashCredit.Text = "Credit", " AND (PURCHASE.ACCODE = '" & txtSupl.Tag & "')", "")
SQL = "SHAPE {SELECT CASE WHEN Purchase.VTYPE='PV' THEN 'Purchase' ELSE 'Purchase Return' END as VoucherType, Purchase.VNO, Purchase.VDATE, Purchase.ACCODE, Purchase.ACDESC, Purchase.SUPP_INV_NO, Purchase.SUPP_INV_DATE, Purchase.PROD_VALUE, Purchase.NET_PAYABLE, Purchase.REMARK, Purchase.CARTAGE, Purchase.TAX " & _
"FROM Purchase WHERE (Purchase.VDATE BETWEEN '" & DtFrom & "' AND '" & DtTo & "')" & SuplType & PrchOrPrchReturn & SuplCode & " Order by Vdate;} AS PrchRegisCmd COMPUTE PrchRegisCmd, SUM(PrchRegisCmd.'NET_PAYABLE') AS SubTotalNetPayable BY 'VoucherType'"
If DE.PrchRegisConn.State = adStateOpen Then DE.PrchRegisConn.Close
DE.PrchRegisConn.Open ShapeConnectString
If DE.rsPrchRegisCmd_Grouping.State = adStateOpen Then DE.rsPrchRegisCmd_Grouping.Close
DE.rsPrchRegisCmd_Grouping.Open SQL, DE.PrchRegisConn, adOpenStatic, adLockOptimistic
PrchRegisRpt.Sections("PageHeader").Controls("Label1").Visible = (chkMRN.Value = vbChecked)
PrchRegisRpt.Sections("PrchRegisCmd_Detail").Controls("txtVNO").Visible = (chkMRN.Value = vbChecked)
Set PrchRegisRpt.DataSource = DE
'Calculate Sale-Sale Return
If DE.rsPrchRegisCmd_Grouping.RecordCount > 0 Then
DE.rsPrchRegisCmd_Grouping.MoveFirst 'Purchase Values
NetValue = DE.rsPrchRegisCmd_Grouping("SubTotalNetPayable").Value
If DE.rsPrchRegisCmd_Grouping.RecordCount = 2 Then
DE.rsPrchRegisCmd_Grouping.MoveNext 'Purchase Return Values
NetValue = NetValue - DE.rsPrchRegisCmd_Grouping("SubTotalNetPayable").Value
End If
PrchRegisRpt.Sections("ReportFooter").Controls("PayableLbl").Caption = Format(CStr(NetValue), "#0.#0")
DE.rsPrchRegisCmd_Grouping.MoveFirst
End If
If Option1(0).Value Then PrchRegisRpt.Show Else PrchRegisRpt.PrintReport
ErHand:
ErrHandler "SaleFrm.CmdPrint"
End Sub
Sponsored Links