Due to some technical error All Project source code & Project report are now available on www.ignousupport.blogspot.com Download all project for free
Sales Form
'******************************************************************
'******************************************************************
'** Author : Samee Ullah Siddiqui
'** Subject : Manipulate Sale/Sale Return Details
'** Date : Wednesday, August, 27, 2003
'** Modified : Saturday, August, 30, 2003
'******************************************************************
'******************************************************************
Dim ADDMode As Boolean
Dim EditMode As Boolean
Dim EmptyTable As Boolean
Dim VoucherType As String
Dim FormLoaded As Boolean
Dim SaleRst As ADODB.Recordset
Dim Bmark
Dim Conn As ADODB.Connection
Dim WithEvents vMenu As Menu
Const NumFormat As String = "#0.#0"
Private Sub AddCmd_Click()
ADDMode = True
Call SetControls
Call ClearFields
Call CashCB_Click
Conn.BeginTrans
End Sub
Private Sub CancelCmd_Click()
Conn.RollbackTrans
ADDMode = False
EditMode = False
Call SetControls
End Sub
Private Sub CashCB_Click()
Set PartySrch.BoundTextBox = IIf(CashCB.ListIndex <= 0, Nothing, PartyTxt)
BillNoTxt = GetVoucherCode
End Sub
Private Sub DelCmd_Click()
If BillNoTxt = "" Then MsgBox "Please select voucher no. to delete", vbCritical, "Invalid voucher no.": Exit Sub
If MsgBox("This will delete selected voucher. Are you sure to delete it.", vbQuestion + vbYesNo + vbDefaultButton2, "Deletion Confirmation") = vbNo Then Exit Sub
Call DeleteVoucher
Conn.CommitTrans
VnoSrch.PopulateList
SaleRst.Requery
If Not (SaleRst.RecordCount) > 0 Then EmptyTable = True
ADDMode = False
EditMode = False
Call SetControls
Call SetFieldsValues(SaleRst)
End Sub
Private Sub DisAmtTxt_GotFocus()
SelectText DisAmtTxt
End Sub
Private Sub DisAmtTxt_KeyPress(KeyAscii As Integer)
ValidateNumber KeyAscii
End Sub
Private Sub DisAmtTxt_Validate(Cancel As Boolean)
If Not (ADDMode Or EditMode) Then Exit Sub
ValidateDesimal DisAmtTxt, Cancel, 2
If Cancel Then Exit Sub
If TotalLbl.Caption = "" Then TotalLbl.Caption = 0#
If DisAmtTxt = "" Then DisPerTxt = "": Exit Sub
DisPerTxt = Format(Val(DisAmtTxt) / (Val(TotalLbl) / 100), NumFormat)
DisAmtTxt = Format(DisAmtTxt, NumFormat)
Call CalculateAmount
End Sub
Private Sub DisPerTxt_GotFocus()
SelectText DisPerTxt
End Sub
Private Sub DisPerTxt_KeyPress(KeyAscii As Integer)
ValidateNumber KeyAscii
End Sub
Private Sub DisPerTxt_Validate(Cancel As Boolean)
If Not (ADDMode Or EditMode) Then Exit Sub
ValidateDesimal DisPerTxt, Cancel, 2
If Cancel Then Exit Sub
If TotalLbl.Caption = "" Then TotalLbl.Caption = 0#
If DisPerTxt = "" Then DisAmtTxt = "": Exit Sub
DisAmtTxt = Format((Val(TotalLbl) / 100) * Val(DisPerTxt), NumFormat)
DisPerTxt = Format(DisPerTxt, NumFormat)
Call CalculateAmount
End Sub
Private Sub EditCmd_Click()
EditMode = True
Call SetControls
Call ClearFields
ItemGrid.RefreshEditor
Conn.BeginTrans
End Sub
Private Sub ExitCmd_Click()
Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
If (Me.ActiveControl.Name = "PartyTxt" And CashCB.ListIndex = 1) Then Exit Sub
If (Me.ActiveControl.Name = "ItemGrid") Then Exit Sub
If (Me.ActiveControl.Name = "SalesManTxt") Then Exit Sub
If (EditMode And Me.ActiveControl.Name = "BillNoTxt") Then Exit Sub
SendKeys "{TAB}"
ElseIf Shift = vbCtrlMask And KeyCode = vbKeyLeft Then
If PrevCmd.Enabled Then PrevCmd.SetFocus
Call PrevCmd_Click
ElseIf Shift = vbCtrlMask And KeyCode = vbKeyRight Then
If NextCmd.Enabled Then NextCmd.SetFocus
Call NextCmd_Click
ElseIf Shift = vbCtrlMask And KeyCode = vbKeyHome Then
If TopCmd.Enabled Then TopCmd.SetFocus
Call TopCmd_Click
ElseIf Shift = vbCtrlMask And KeyCode = vbKeyEnd Then
If LastCmd.Enabled Then LastCmd.SetFocus
Call LastCmd_Click
End If
End Sub
Private Sub SetGridProps(Optional Rows As Integer)
With ItemGrid
.Clear
.FormatString = "S No.|<Item Particulars|>Packing|>Stock|>Qty|>Rate|>Amount|IID|Stock|OldQty"
.Rows = IIf(Rows <= 1, 2, Rows)
.ColWidth(1) = TextWidth("A") * 60 'PARTICULARS
.ColWidth(2) = TextWidth("A") * 6 'SIZE
.ColWidth(3) = TextWidth("A") * 6 'Stock
.ColWidth(4) = TextWidth("A") * 8 'QUANTITY
.ColWidth(5) = TextWidth("A") * 8 'RATE
.ColWidth(6) = TextWidth("A") * 15 'AMOUNT
.ColWidth(7) = TextWidth("A") * 0 'Item Code
.ColWidth(8) = TextWidth("A") * 0 'Stock
.ColWidth(9) = TextWidth("A") * 0 'Old Quantity
.EnableEditing(3) = False 'Stock
.EnableEditing(6) = False 'Amount
.EnableEditing(7) = False 'Item Code
.EnableEditing(8) = False 'Stock
.EnableEditing(9) = False 'Old Quantity
.NumbersOnly(2, 3, 50) = True
.NumbersOnly(3, 7) = True
.NumbersOnly(4, 4) = True
.NumbersOnly(5, 6) = True
.NumbersOnly(6, 10) = True
End With
End Sub
Private Sub Form_Paint()
If FormLoaded Then Exit Sub
VoucherType = Me.Tag
If Me.Tag = "" Then
MsgBox "Cannot indentified voucher type.", vbCritical, "Application Terminated"
Exit Sub
End If
Me.Caption = IIf(VoucherType = "SV", "Sale Entry", "Sale Return Entry")
Label1(1).Caption = IIf(VoucherType = "SV", "Sale Entry", "Sale Return Entry")
Label2(4).Caption = IIf(VoucherType = "SV", "Bill No.", "Credit Note No.")
Set Conn = New ADODB.Connection
Conn.mode = adModeReadWrite
Conn.CursorLocation = adUseClient
Conn.Open ShapeConnectString
With ItemSrch
.DBConnectString = ConnectString
'.SQLString = "SELECT ItemCode, Item_Desc FROM ITEM "
.SQLString = "SELECT ItemCode, Item_Desc + space(3) + ' -> Packing =' + Packing FROM ITEM where IGCode = '0001'"
.PopulateList
End With
With PartySrch
.DBConnectString = ConnectString
.SQLString = "SELECT ACCode, ACDESC, ACALIAS FROM ACMAST WHERE RECTYPE = 'A' AND CASH = 'R' And ( GRCode='000037' Or GRCode='000016')"
.WithAlias = True
.PopulateList
End With
With SalesManSrch
.DBConnectString = ConnectString
.SQLString = "SELECT ACCode, ACDESC FROM ACMAST WHERE GRCODE = '000029'" 'Other Staff = 000029
Set .BoundTextBox = SalesManTxt
.PopulateList
End With
With VnoSrch
.DBConnectString = ConnectString
.SQLString = "SELECT VNO, VNO + space(5) + ACDESC FROM SALE WHERE VTYPE = '" & VoucherType & "'"
.PopulateList
End With
Call SetGridProps
Set SaleRst = New ADODB.Recordset
SaleRst.CursorLocation = adUseClient
Dim SQL As String
SQL = "SHAPE {SELECT SALE.ID, SALE.VTYPE, SALE.VNO, SALE.VDATE, SALE.ACCODE AS PARTYCODE, SALE.ACDESC AS PARTYNAME, SALE.SALESMANCODE, ACMAST.ACDESC AS SALESMANNAME, SALE.PROD_VALUE, SALE.DISCPER, SALE.DISCOUNT, SALE.TAXPER, SALE.NET_PAYABLE, SALE.REMARK " & _
"FROM SALE LEFT JOIN ACMAST ON SALE.SALESMANCODE = ACMAST.ACCODE WHERE SALE.VTYPE='" & VoucherType & "' Order By SALE.VDATE DESC, SUBSTRING(SALE.VNO,2,Len(SALE.VNO)-1) DESC} " & _
"AS SALE APPEND ({SELECT Ledger.VTYPE, Ledger.VNO, Ledger.ICODE, ITEM.Item_Desc, Ledger.QTY, Ledger.Rate, Ledger.ISIZE, [Ledger].[Qty]*[Ledger].[Rate] AS Amount, ITEMSIZE.STOCK " & _
"FROM (Ledger LEFT JOIN ITEM ON Ledger.ICODE = ITEM.ItemCode) LEFT JOIN ITEMSIZE ON (Ledger.ISIZE = ITEMSIZE.ISIZE) AND (Ledger.ICODE = ITEMSIZE.ICODE)} AS Items RELATE 'VTYPE' TO 'VTYPE','VNO' TO 'VNO') AS Items"
SaleRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
If SaleRst.RecordCount > 0 Then
Call SetFieldsValues(SaleRst)
Else
EmptyTable = True
End If
Call SetControls
FormLoaded = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
SaleRst.Close
Set SaleRst = Nothing
Conn.Close
Set Conn = Nothing
End Sub
Private Sub SetControls()
'Set Forms Control's status
'Called in ItemDBCtl_MoveComplete(), Form_Load(), Navigation Buttons Click()
VoucherFrame.Enabled = (ADDMode Or EditMode)
ItemFrame.Enabled = (ADDMode Or EditMode)
AddCmd.Enabled = Not (ADDMode Or EditMode)
EditCmd.Enabled = Not (EmptyTable Or ADDMode Or EditMode)
PrintCmd.Enabled = Not (EmptyTable Or ADDMode Or EditMode)
PrintChk.Enabled = Not (EmptyTable Or ADDMode Or EditMode)
SaveCmd.Enabled = (ADDMode Or EditMode)
CancelCmd.Enabled = (ADDMode Or EditMode)
CancelCmd.Cancel = (ADDMode Or EditMode)
DelCmd.Enabled = (Not EmptyTable) And (EditMode)
'DelCmd.Enabled = False
ExitCmd.Enabled = Not (ADDMode Or EditMode)
ExitCmd.Cancel = Not (ADDMode Or EditMode)
ItemGrid.ShowEditor = (ADDMode Or EditMode)
If Not (ADDMode Or EditMode) Then PartySrch.HideList
If Not (ADDMode Or EditMode) Then ItemSrch.HideList
If Not (ADDMode Or EditMode) Then VnoSrch.HideList
If Not (ADDMode Or EditMode) Then SalesManSrch.HideList
CashCB.Enabled = Not EditMode
If (ADDMode Or EditMode) Then
ItemGrid.Col = 1
ItemGrid.Row = IIf(ADDMode, 1, ItemGrid.Rows - 1)
End If
Set VnoSrch.BoundTextBox = IIf(EditMode, BillNoTxt, Nothing)
TopCmd.Enabled = (Not (EmptyTable Or ADDMode Or EditMode)) And (SaleRst.AbsolutePosition > 1)
PrevCmd.Enabled = (Not (EmptyTable Or ADDMode Or EditMode)) And (SaleRst.AbsolutePosition > 1)
NextCmd.Enabled = (Not (EmptyTable Or ADDMode Or EditMode)) And (SaleRst.AbsolutePosition < SaleRst.RecordCount)
LastCmd.Enabled = (Not (EmptyTable Or ADDMode Or EditMode)) And (SaleRst.AbsolutePosition < SaleRst.RecordCount)
Timer1.Enabled = (ADDMode Or EditMode)
End Sub
Private Sub ItemGrid_EnterCell()
If Not (ADDMode Or EditMode) Then Exit Sub
If ItemGrid.Col = 1 Then
ItemSrch.SearchValue ItemGrid.Text
Else
Call SelectText(ItemGrid.GridTextBox)
End If
End Sub
Private Sub ItemGrid_LeaveCell()
On Error GoTo ErHand
Dim rst As ADODB.Recordset
If Not (ADDMode Or EditMode) Then Exit Sub
If ItemGrid.Col = 1 Then
'ItemGrid.TextMatrix(ItemGrid.Row, 1) = ItemSrch.SelectedCompany
'ItemGrid.TextMatrix(ItemGrid.Row, 7) = ItemSrch.UniqueCode
ItemGrid.TextMatrix(ItemGrid.Row, 1) = Mid(ItemSrch.SelectedCompany, 1, InStr(ItemSrch.SelectedCompany, "-") - 1)
ItemGrid.TextMatrix(ItemGrid.Row, 2) = Right(ItemSrch.SelectedCompany, Len(ItemSrch.SelectedCompany) - InStr(ItemSrch.SelectedCompany, "="))
ItemGrid.TextMatrix(ItemGrid.Row, 7) = ItemSrch.UniqueCode
ElseIf ItemGrid.Col = 2 Then
'Get Stock Value of selected item
If (ItemGrid.TextMatrix(ItemGrid.Row, 7) = "" Or ItemGrid.TextMatrix(ItemGrid.Row, 2) = "") Then Exit Sub
Dim SQL As String
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseClient
SQL = "SELECT * FROM ITEMSIZE WHERE ICODE = '" & ItemGrid.TextMatrix(ItemGrid.Row, 7) & "' AND ISIZE = " & ItemGrid.TextMatrix(ItemGrid.Row, 2)
rst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
If rst.RecordCount > 0 Then
ItemGrid.TextMatrix(ItemGrid.Row, 3) = IIf(IsNull(rst!STOCK), 0, rst!STOCK)
ItemGrid.TextMatrix(ItemGrid.Row, 8) = IIf(IsNull(rst!STOCK), 0, rst!STOCK)
Else
'Inserting new entry in itemsize table if not exist
rst.AddNew
rst!ICODE = ItemGrid.TextMatrix(ItemGrid.Row, 7)
rst!ISIZE = ItemGrid.TextMatrix(ItemGrid.Row, 2)
rst!STOCK = 0
rst!OPPRCHRATE = 0
rst!PRCHRATE = 0
rst.Update
ItemGrid.TextMatrix(ItemGrid.Row, 3) = 0
ItemGrid.TextMatrix(ItemGrid.Row, 8) = 0
End If
rst.Close
'Display Last Salling Rate of Selected Item
If ADDMode And VoucherType = "SV" Then
ItemGrid.TextMatrix(ItemGrid.Row, 5) = RecentRate(ItemGrid.TextMatrix(ItemGrid.Row, 7), VoucherType)
End If
ElseIf ItemGrid.Col = 4 Then
Dim vQty As Integer
If ADDMode Then
ItemGrid.TextMatrix(ItemGrid.Row, 3) = IIf(VoucherType = "SV", Val(ItemGrid.TextMatrix(ItemGrid.Row, 8)) - Val(ItemGrid.TextMatrix(ItemGrid.Row, 4)), Val(ItemGrid.TextMatrix(ItemGrid.Row, 8)) + Val(ItemGrid.TextMatrix(ItemGrid.Row, 4)))
Else
vQty = IIf(VoucherType = "SV", Val(ItemGrid.TextMatrix(ItemGrid.Row, 8)) + Val(ItemGrid.TextMatrix(ItemGrid.Row, 9)), Val(ItemGrid.TextMatrix(ItemGrid.Row, 8)) - Val(ItemGrid.TextMatrix(ItemGrid.Row, 9))) 'vQty = Stock +- OldQuantity
ItemGrid.TextMatrix(ItemGrid.Row, 3) = IIf(VoucherType = "SV", vQty - Val(ItemGrid.TextMatrix(ItemGrid.Row, 4)), vQty + Val(ItemGrid.TextMatrix(ItemGrid.Row, 4))) 'Stock = vQty +- NewQuantity
End If
ElseIf ItemGrid.Col = 5 Then
'Update Sale Rate of item with entered sale rate
'SQL = "UPDATE ITEM SET SALE_RATE = " & Val(ItemGrid.TextMatrix(ItemGrid.Row, 5)) & " WHERE ITEMCODE = '" & ItemGrid.TextMatrix(ItemGrid.Row, 7) & "'"
'Conn.Execute SQL
'ItemGrid.TextMatrix(ItemGrid.Row, 6) = AmountValue(ItemGrid.TextMatrix(ItemGrid.Row, 4), ItemGrid.TextMatrix(ItemGrid.Row, 5))
Call ItemGrid_LostFocus
End If
ErHand:
If err.Number = 0 Then Exit Sub
If err.Description = "Could not update; currently locked." Then '-2147467259
MsgBox "The record you are trying to save could not successful because required table is currently used by another module's transaction." & vbCrLf & vbCrLf & "Please finish the active transaction (Save/Cancel) in that module and then try again.", vbExclamation, "Table Locked"
rst.CancelUpdate
Call CancelCmd_Click
Exit Sub
Else
ErrHandler "SaleFrm.ItemGrid_LeaveCell"
End If
End Sub
Private Sub ItemGrid_LostFocus()
TotalLbl.Caption = Format(SumOfValues(6), NumFormat)
End Sub
Private Sub ItemGrid_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not EditMode Then Exit Sub
End Sub
Private Sub LastCmd_Click()
LastMove SaleRst
Call SetFieldsValues(SaleRst)
Call SetControls
End Sub
Private Sub BillNoTxt_GotFocus()
SelectText BillNoTxt
End Sub
Private Sub BillNoTxt_Validate(Cancel As Boolean)
If Not (ADDMode) Then Exit Sub
If Len(Trim(BillNoTxt)) <> 6 Then
MsgBox Label2(4).Caption & " must be of 6 character.", vbCritical, "Invalid Value"
Cancel = True
Exit Sub
End If
Dim SQL As String
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
SQL = "SELECT * FROM SALE WHERE VNO = '" & BillNoTxt & "'AND VTYPE = '" & VoucherType & "'"
rst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rst.RecordCount > 0 Then
MsgBox Label2(4).Caption & " is already exist. Please enter unique no.", vbCritical, "Invalid Value"
Cancel = True
Exit Sub
End If
End Sub
Private Sub NextCmd_Click()
NextMove SaleRst
Call SetFieldsValues(SaleRst)
Call SetControls
End Sub
Private Sub PrevCmd_Click()
PreviousMove SaleRst
Call SetFieldsValues(SaleRst)
Call SetControls
End Sub
Private Sub PrintCmd_Click()
On Error GoTo ErHand
Dim SQL As String
If DE.SaleConn.State = adStateOpen Then DE.SaleConn.Close
DE.SaleConn.Open ShapeConnectString
Set SaleBillRpt.DataSource = DE
SaleBillRpt.Sections("ReportHeader").Controls("lblHeader").Caption = IIf(VoucherType = "SV", "Bill/Invoice", "Sale Return/Credit Note")
SaleBillRpt.Sections("PageFooter").Controls("lblSubTotal").Caption = Me.TotalLbl
SaleBillRpt.Sections("PageFooter").Controls("lblDiscount").Caption = Me.DisAmtTxt
SaleBillRpt.Sections("PageFooter").Controls("lblTotal").Caption = Me.NetAmtLbl
SaleBillRpt.Sections("PageFooter").Controls("lblDiscount").Visible = Val(Me.DisAmtTxt) > 0
SaleBillRpt.Sections("PageFooter").Controls("Label12").Visible = Val(Me.DisAmtTxt) > 0
SaleBillRpt.Sections("PageFooter").Controls("lblRemark").Visible = Trim(Me.RmrkTxt) <> ""
SaleBillRpt.Sections("PageFooter").Controls("lblRemark").Caption = Trim(Me.RmrkTxt)
SaleBillRpt.Sections("PageFooter").Controls("Label14").Visible = Trim(Me.RmrkTxt) <> ""
SaleBillRpt.Sections("PageFooter").Controls("Label13").Caption = IIf(VoucherType = "SV", "Net Amount Rs.", "We owe you Rs.")
SaleBillRpt.Sections("PageFooter").Controls("lblTerms1").Visible = (VoucherType = "SV")
SaleBillRpt.Sections("PageFooter").Controls("lblTerms2").Visible = (VoucherType = "SV")
SaleBillRpt.Sections("PageFooter").Controls("lblTerms3").Visible = (VoucherType = "SV")
SQL = "SHAPE {SELECT Sale.VTYPE, Sale.VNO, Sale.VDATE, Sale.ACCODE AS PARTYCODE, Sale.ACDESC AS PARTY, Sale.SALESMANCODE, ACMAST.ACDESC AS SALESMANNAME, Sale.PROD_VALUE, Sale.DISCPER, Sale.DISCOUNT, Sale.TAXPER, Sale.NET_PAYABLE, Sale.REMARK " & _
"FROM Sale LEFT JOIN ACMAST ON Sale.SALESMANCODE = ACMAST.ACCODE WHERE VTYPE = '" & VoucherType & "' AND VNO = '" & BillNoTxt & "'} AS SaleCmd APPEND ({SELECT Ledger.VTYPE, Ledger.VNO, Ledger.ICODE, ITEM.Item_Desc + SPACE(5) + ITEM.PACKING AS [Item_Desc], Ledger.QTY, Ledger.Rate, [Ledger].[Qty]*[Ledger].[Rate] AS Amount " & _
"FROM Ledger LEFT JOIN ITEM ON Ledger.ICODE = ITEM.ItemCode;} AS SaleItemCmd RELATE 'VTYPE' TO 'VTYPE','VNO' TO 'VNO') AS SaleItemCmd"
If DE.rsSaleCmd.State = adStateOpen Then DE.rsSaleCmd.Close
DE.rsSaleCmd.Open SQL, DE.SaleConn
If PrintChk.Value = vbChecked Then SaleBillRpt.Show Else SaleBillRpt.PrintReport
ErHand:
ErrHandler "SaleFrm.CmdPrint"
End Sub
Private Sub SaveCmd_Click()
If Not SavedData Then Exit Sub
Conn.CommitTrans
On Error Resume Next
If ADDMode Then
VnoSrch.AddItem BillNoTxt & "|" & BillNoTxt & Space(5) & Trim(PartyTxt.Text)
EmptyTable = False
Else
VnoSrch.PopulateList
End If
SaleRst.Requery
If EditMode And Not IsEmpty(Bmark) Then SaleRst.Bookmark = Bmark
Call SetFieldsValues(SaleRst)
ADDMode = False
EditMode = False
Call SetControls
End Sub
Private Function SavedData() As Boolean
On Error GoTo ErrHand
If Not ValidateData Then Exit Function
Dim ProductValue, TaxAmountValue As Double
Dim SavedRows, i As Integer
Dim SQL As String
For i = 1 To ItemGrid.Rows - 1
If Not (ItemGrid.TextMatrix(i, 1) = "" Or ItemGrid.TextMatrix(i, 2) = "" _
Or ItemGrid.TextMatrix(i, 3) = "" Or ItemGrid.TextMatrix(i, 4) = "" _
Or ItemGrid.TextMatrix(i, 5) = "" Or ItemGrid.TextMatrix(i, 6) = "" Or ItemGrid.TextMatrix(i, 7) = "") Then SavedRows = SavedRows + 1
Next i
If Not SavedRows > 0 Then
MsgBox "There is no items to save.", vbExclamation, "No Items"
ItemGrid.SetFocus
Exit Function
End If
Dim VoucherNo As String
Dim VoucherRst As New ADODB.Recordset
VoucherRst.CursorLocation = adUseClient
Dim SaleRst As New ADODB.Recordset
SaleRst.CursorLocation = adUseClient
Dim SRst As New ADODB.Recordset
SRst.CursorLocation = adUseClient
SRst.Open "SELECT MAX(ID) FROM SALE", Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
SrNo = IIf(IsNull(SRst(0)), 0, SRst(0)) + 1
VoucherNo = IIf(ADDMode, GetVoucherCode(), BillNoTxt.Text)
'Saving data to sale table
If ADDMode Then
SQL = "SELECT * FROM SALE"
Else
SQL = "SELECT * FROM SALE WHERE VTYPE = '" & VoucherType & "' AND VNO = '" & VoucherNo & "'"
End If
ProductValue = (Val(NetAmtLbl) * 100) / (100 + Val(TaxPerTxt))
TaxAmountValue = (ProductValue * Val(TaxPerTxt)) / 100
SaleRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
If ADDMode Then
SaleRst.AddNew
SaleRst!VType = VoucherType
SaleRst!Vno = VoucherNo
SaleRst!ID = SrNo
End If
SaleRst!vDate = VoucherDate.Value
SaleRst!AcCode = IIf(CashCB.ListIndex <= 0, "000030", PartyTxt.Tag)
SaleRst!AcDESC = Trim(PartyTxt)
SaleRst!SALESMANCODE = SalesManTxt.Tag
SaleRst!PROD_VALUE = ProductValue
SaleRst!DISCPER = Val(DisPerTxt)
SaleRst!DISCOUNT = Val(DisAmtTxt)
SaleRst!TAXPER = Val(TaxPerTxt)
SaleRst!TAXAMT = TaxAmountValue
SaleRst!NET_PAYABLE = Val(NetAmtLbl)
SaleRst!REMARK = Trim(RmrkTxt)
SaleRst.Update
'Update ACTRANS Table at Editing Time
SQL = "SELECT * FROM VOUCHER WHERE VTYPE = '" & VoucherType & "' AND VNO = '" & VoucherNo & "'"
If VoucherRst.State = adStateOpen Then VoucherRst.Close
VoucherRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
Do Until VoucherRst.EOF
Call BalancePost(EditPosting, IIf(VoucherRst!DrCr = "D", VoucherRst!DrAmt, VoucherRst!CrAmt), VoucherRst!DrCr, VoucherRst!AcCode, Conn)
VoucherRst.Delete
VoucherRst.MoveNext
Loop
'Saving data to voucher table
If VoucherRst.State = adStateOpen Then VoucherRst.Close
VoucherRst.Open "VOUCHER", Conn, adOpenKeyset, adLockOptimistic, adCmdTable
VoucherRst.AddNew
VoucherRst!sno = GetVoucherID
VoucherRst!VType = VoucherType
VoucherRst!Vno = VoucherNo
VoucherRst!vDate = VoucherDate.Value
VoucherRst!AcCode = IIf(CashCB.ListIndex <= 0, "000030", PartyTxt.Tag) 'Cash Account
VoucherRst!ACContra = "000032"
VoucherRst!DrAmt = IIf(VoucherType = "SV", NetAmtLbl, 0)
VoucherRst!CrAmt = IIf(VoucherType = "SV", 0, NetAmtLbl)
VoucherRst!DrCr = IIf(VoucherType = "SV", "D", "C")
'voucherrst!NARR
VoucherRst.Update
VoucherRst.AddNew
VoucherRst!sno = GetVoucherID
VoucherRst!VType = VoucherType
VoucherRst!Vno = VoucherNo
VoucherRst!vDate = VoucherDate.Value
VoucherRst!AcCode = "000032" 'Sale Account = 000032
VoucherRst!ACContra = IIf(CashCB.ListIndex <= 0, "000030", PartyTxt.Tag) 'Cash Account (Cash in Hand) = 000030
VoucherRst!DrAmt = IIf(VoucherType = "SV", 0, ProductValue)
VoucherRst!CrAmt = IIf(VoucherType = "SV", ProductValue, 0)
VoucherRst!DrCr = IIf(VoucherType = "SV", "C", "D")
'voucherrst!NARR
VoucherRst.Update
If TaxAmountValue > 0 Then
VoucherRst.AddNew
VoucherRst!sno = GetVoucherID
VoucherRst!VType = VoucherType
VoucherRst!Vno = VoucherNo
VoucherRst!vDate = VoucherDate.Value
VoucherRst!AcCode = "000034" 'Trade Tax =000034
VoucherRst!ACContra = IIf(CashCB.ListIndex <= 0, "000030", PartyTxt.Tag) 'Cash Account (Cash in Hand)
VoucherRst!DrAmt = IIf(VoucherType = "SV", 0, TaxAmountValue)
VoucherRst!CrAmt = IIf(VoucherType = "SV", TaxAmountValue, 0)
VoucherRst!DrCr = IIf(VoucherType = "SV", "C", "D")
'voucherrst!NARR
VoucherRst.Update
End If
'Update ACTRANS Table
SQL = "SELECT * FROM VOUCHER WHERE VTYPE = '" & VoucherType & "' AND VNO = '" & VoucherNo & "'"
If VoucherRst.State = adStateOpen Then VoucherRst.Close
VoucherRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
Do Until VoucherRst.EOF
Call BalancePost(ADDPosting, IIf(VoucherRst!DrCr = "D", VoucherRst!DrAmt, VoucherRst!CrAmt), VoucherRst!DrCr, VoucherRst!AcCode, Conn)
VoucherRst.MoveNext
Loop
Dim LgrRst As New ADODB.Recordset
LgrRst.CursorLocation = adUseClient
'Saving data to ledger table
If EditMode Then
SQL = "SELECT * FROM LEDGER WHERE VTYPE = '" & VoucherType & "' AND VNO = '" & VoucherNo & "'"
LgrRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
Do Until LgrRst.EOF
SQL = "UPDATE ITEMSIZE SET STOCK = STOCK " & IIf(VoucherType = "SV", "+", "-") & IIf(IsNull(LgrRst!Qty), 0, LgrRst!Qty) & " WHERE ICODE = '" & LgrRst!ICODE & "' AND ISIZE = " & LgrRst!ISIZE
Conn.Execute SQL
LgrRst.MoveNext
Loop
SQL = "DELETE FROM LEDGER WHERE VTYPE = '" & VoucherType & "' AND VNO = '" & VoucherNo & "'"
Conn.Execute SQL
End If
If LgrRst.State = adStateOpen Then LgrRst.Close
LgrRst.Open "LEDGER", Conn, adOpenKeyset, adLockOptimistic, adCmdTable
With ItemGrid
For i = 1 To .Rows - 1
If Not (.TextMatrix(i, 1) = "" Or .TextMatrix(i, 2) = "" _
Or .TextMatrix(i, 3) = "" Or .TextMatrix(i, 4) = "" _
Or .TextMatrix(i, 5) = "" Or .TextMatrix(i, 6) = "" Or .TextMatrix(i, 7) = "") Then
LgrRst.AddNew
LgrRst!ID = GetLedgerID
LgrRst!VType = VoucherType
LgrRst!Vno = VoucherNo
LgrRst!vDate = VoucherDate.Value
LgrRst!ICODE = .TextMatrix(i, 7)
LgrRst!ISIZE = .TextMatrix(i, 2)
LgrRst!Qty = .TextMatrix(i, 4)
LgrRst!Rate = .TextMatrix(i, 5)
LgrRst.Update
SQL = "UPDATE ITEMSIZE SET STOCK = STOCK " & IIf(VoucherType = "SV", "-", "+") & .TextMatrix(i, 4) & " WHERE ICODE = '" & .TextMatrix(i, 7) & "' AND ISIZE = " & .TextMatrix(i, 2)
Conn.Execute SQL
End If
Next i
End With
SavedData = True
Exit Function
ErrHand:
ErrHandler "Function SaleFrm.SavedData"
End Function
Private Function ValidateData() As Boolean
If CashCB.ListIndex = -1 Then
MsgBox "Please Select Cash or Credit.", vbExclamation, "Invalid Value"
CashCB.SetFocus
ElseIf CashCB.ListIndex = 1 And Trim(PartyTxt.Tag) = "" Then
MsgBox "Please Select supplier name from list.", vbExclamation, "Invalid Value"
PartyTxt.SetFocus
ElseIf SalesManTxt = "" Or SalesManTxt.Tag = "" Then
MsgBox "Please select salesman name from list.", vbExclamation, "Invalid Value"
SalesManTxt.SetFocus
ElseIf Not IsDate(VoucherDate.Value) Then
MsgBox "Please enter voucher Date.", vbExclamation, "Invalid Value"
VoucherDate.SetFocus
Else
ValidateData = True
End If
End Function
Private Sub ItemGrid_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Not (ItemGrid.TextMatrix(ItemGrid.Row, 1) = "" Or _
ItemGrid.TextMatrix(ItemGrid.Row, 2) = "" Or _
ItemGrid.TextMatrix(ItemGrid.Row, 3) = "" Or _
ItemGrid.TextMatrix(ItemGrid.Row, 4) = "" Or _
ItemGrid.TextMatrix(ItemGrid.Row, 5) = "") Then
ItemGrid.TextMatrix(ItemGrid.Row, 0) = ItemGrid.Row
ItemGrid.CreateNewRows = True
Else
ItemGrid.CreateNewRows = False
End If
ElseIf ItemGrid.Col = 2 Or ItemGrid.Col = 3 Or ItemGrid.Col = 4 Then
If Not (InStr(".0123456789", Chr(KeyAscii)) > 0) And KeyAscii <> 8 Then KeyAscii = 0
End If
End Sub
Private Function SumOfValues(ByVal GridCol As Integer) As Double
Dim i, vSumVal As Double
If Not ItemGrid.Cols > GridCol Then Exit Function
For i = 1 To ItemGrid.Rows - 1
ItemGrid.TextMatrix(i, 6) = AmountValue(ItemGrid.TextMatrix(i, 4), ItemGrid.TextMatrix(i, 5))
If ItemGrid.TextMatrix(i, GridCol) = "" Then ItemGrid.TextMatrix(i, GridCol) = "0"
If Not IsNumeric(ItemGrid.TextMatrix(i, GridCol)) Then ItemGrid.TextMatrix(i, GridCol) = "0"
vSumVal = vSumVal + ItemGrid.TextMatrix(i, GridCol)
Next i
SumOfValues = Format(vSumVal, NumFormat)
End Function
Private Function AmountValue(ByVal Rate, ByVal Qty) As String
Dim vVal As Double
If Rate = "" Then Rate = 0
If Qty = "" Then Qty = 0
If Not IsNumeric(Rate) Then Rate = 0
If Not IsNumeric(Qty) Then Qty = 0
vVal = Rate * Qty
AmountValue = Format(vVal, NumFormat)
End Function
Private Function GetVoucherCode() As String
Dim RS As New ADODB.Recordset
Dim SQL As String
SQL = "Select Max(substring(VNO,2,Len(VNO)-1)) From SALE WHERE LEFT(VNO,1) = '" & IIf(CashCB.ListIndex <= 0, "C", "R") & "' AND VTYPE = '" & VoucherType & "'"
RS.Open SQL, Conn, adOpenDynamic, adLockOptimistic
GetVoucherCode = IIf(CashCB.ListIndex <= 0, "C", "R") & GetProperCode(IIf(IsNull(RS(0)), "1", RS(0) + 1), 5)
End Function
Private Sub TaxPerTxt_Change()
If Not (ADDMode Or EditMode) Then Exit Sub
Call CalculateAmount
End Sub
Private Sub TaxPerTxt_GotFocus()
SelectText TaxPerTxt
End Sub
Private Sub TaxPerTxt_KeyPress(KeyAscii As Integer)
ValidateNumber KeyAscii
End Sub
Private Sub TaxPerTxt_Validate(Cancel As Boolean)
ValidateDesimal TaxPerTxt, Cancel, 2
TaxPerTxt = Format(TaxPerTxt, NumFormat)
End Sub
Private Sub TopCmd_Click()
TopMove SaleRst
Call SetFieldsValues(SaleRst)
Call SetControls
End Sub
Private Sub TotalLbl_Change()
If Not (ADDMode Or EditMode) Then Exit Sub
Call CalculateAmount
End Sub
Private Sub SetFieldsValues(ByVal rst As ADODB.Recordset)
Dim ItemString As String
Dim ItemRst As New ADODB.Recordset
ItemRst.CursorLocation = adUseClient
If Not rst.RecordCount > 0 Then Exit Sub
If rst.BOF Then rst.MoveFirst
If rst.EOF Then rst.MoveLast
CashCB.ListIndex = IIf(Left(rst!Vno, 1) = "C", 0, 1)
BillNoTxt = rst!Vno
PartyTxt = IIf(IsNull(rst!partyname), "", rst!partyname)
PartyTxt.Tag = IIf(IsNull(rst!PartyCode), "", rst!PartyCode)
SalesManTxt = IIf(IsNull(rst!SALESMANNAME), "", rst!SALESMANNAME)
SalesManTxt.Tag = IIf(IsNull(rst!SALESMANCODE), "", rst!SALESMANCODE)
VoucherDate = rst!vDate
DayLbl = Format(rst!vDate, "dddd")
RmrkTxt = IIf(IsNull(rst!REMARK), "", rst!REMARK)
' TotalLbl = Format(Rst!PROD_VALUE + IIf(IsNull(Rst!DISCOUNT), 0, Rst!DISCOUNT), NumFormat)
TotalLbl = Format(rst!NET_PAYABLE + IIf(IsNull(rst!DISCOUNT), 0, rst!DISCOUNT), NumFormat)
DisPerTxt = Format(IIf(IsNull(rst!DISCPER), 0, rst!DISCPER), NumFormat)
DisAmtTxt = Format(IIf(IsNull(rst!DISCOUNT), 0, rst!DISCOUNT), NumFormat)
TaxPerTxt = Format(IIf(IsNull(rst!TAXPER), 0, rst!TAXPER), NumFormat)
Call CalculateAmount
Set ItemRst = rst("Items").UnderlyingValue
ItemGrid.Rows = 1
If Not ItemRst.RecordCount > 0 Then ItemGrid.AddItem "" 'Add a blank row if Item not found
If ItemRst.RecordCount > 0 Then ItemRst.MoveFirst
Do Until ItemRst.EOF
ItemString = ItemRst.AbsolutePosition & vbTab
ItemString = ItemString & ItemRst!ITEM_DESC & vbTab
ItemString = ItemString & ItemRst!ISIZE & vbTab & ItemRst!STOCK & vbTab
ItemString = ItemString & ItemRst!Qty & vbTab & ItemRst!Rate & vbTab
ItemString = ItemString & Format(ItemRst!amount, NumFormat) & vbTab & ItemRst!ICODE & vbTab & ItemRst!STOCK & vbTab
ItemString = ItemString & ItemRst!Qty
ItemGrid.AddItem ItemString
ItemRst.MoveNext
Loop
ItemGrid.RefreshEditor
End Sub
Private Sub CalculateAmount()
Dim Netamt, Amt As Double
' TaxAmtLbl = TaxAmount(TotalLbl, DisAmtTxt, TaxPerTxt)
' Netamt = (Val(TotalLbl) - Val(DisAmtTxt)) + Val(TaxAmtLbl)
' Amt = Round(Netamt, 0)
' RoundOffLbl = Format(Round((Amt - Netamt), 2), NumFormat)
' NetAmtLbl = Format(Amt, NumFormat)
Netamt = (Val(TotalLbl) - Val(DisAmtTxt))
NetAmtLbl = Format(Netamt, NumFormat)
End Sub
Private Function TaxAmount(ByVal TotalAmt, ByVal DisAmt, ByVal Tax) As String
Dim Amt As Double
If TotalAmt = "" Then TotalAmt = 0
If DisAmt = "" Then DisAmt = 0
If Tax = "" Then Tax = 0
Amt = TotalAmt - DisAmt
TaxAmount = (Amt / 100) * Tax
TaxAmount = Format(TaxAmount, NumFormat)
End Function
Private Sub ClearFields()
CashCB.ListIndex = 0
BillNoTxt = ""
PartyTxt = ""
PartyTxt.Tag = ""
VoucherDate = Date
DayLbl = ""
BillNoTxt = ""
BillDate = ""
RmrkTxt = ""
TotalLbl = ""
NetAmtLbl = ""
DisPerTxt = ""
DisAmtTxt = ""
TaxPerTxt = ""
TaxAmtLbl = ""
RoundOffLbl = ""
SalesManTxt = ""
Call SetGridProps
End Sub
Private Sub vMenu_Click()
If Not EditMode Then Exit Sub
If ItemGrid.Rows > 2 Then
ItemGrid.RemoveItem ItemGrid.Row
Else
ItemGrid.Rows = 1
ItemGrid.AddItem ""
End If
ItemGrid.RefreshEditor
End Sub
Private Sub VnoSrch_ValidateBoundTextBox()
Dim BeforeSearchBmark
BeforeSearchBmark = SaleRst.Bookmark
SaleRst.MoveFirst
SaleRst.Find "VNO='" & BillNoTxt & "'"
If SaleRst.EOF Then
MsgBox "Voucher No. not found.", vbCritical, "Invalid Voucher No."
SaleRst.Bookmark = BeforeSearchBmark
Else
Bmark = SaleRst.Bookmark
Call SetFieldsValues(SaleRst)
End If
End Sub
Private Sub DeleteVoucher()
Dim SQL As String
Dim LgrRst As New ADODB.Recordset
LgrRst.CursorLocation = adUseClient
SQL = "SELECT * FROM LEDGER WHERE VTYPE = '" & VoucherType & "' AND VNO = '" & BillNoTxt & "'"
LgrRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
Do Until LgrRst.EOF
SQL = "UPDATE ITEMSIZE SET STOCK = STOCK " & IIf(VoucherType = "SV", "+", "-") & IIf(IsNull(LgrRst!Qty), 0, LgrRst!Qty) & " WHERE ICODE = '" & LgrRst!ICODE & "' AND ISIZE = " & LgrRst!ISIZE
Conn.Execute SQL
LgrRst.MoveNext
Loop
'Delete from Sale
SQL = "DELETE FROM SALE WHERE VTYPE = '" & VoucherType & "' AND VNO = '" & BillNoTxt & "'"
Conn.Execute SQL
'Delete from Ledger
SQL = "DELETE FROM LEDGER WHERE VTYPE = '" & VoucherType & "' AND VNO = '" & BillNoTxt & "'"
Conn.Execute SQL
'Delete from Voucher
SQL = "DELETE FROM VOUCHER WHERE VTYPE = '" & VoucherType & "' AND VNO = '" & BillNoTxt & "'"
Conn.Execute SQL
End Sub
Private Sub VoucherDate_Validate(Cancel As Boolean)
If Not (ADDMode Or EditMode) Then Exit Sub
If Not IsInFinancialYear(VoucherDate) Then
MsgBox "This date is not of the current financial year", vbCritical, "Invalid Date"
Cancel = True
VoucherDate.SetFocus
Else
DayLbl = Format(VoucherDate, "dddd")
End If
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
If Not ItemGrid.ShowEditor Then Exit Sub
If Not (ActiveControl.Name = "ItemGrid") Then
If ItemSrch.ListVisible Then ItemSrch.HideList
ElseIf (ActiveControl.Name = "ItemGrid") Then
If (ItemGrid.Col = 1) Then
If Not ItemSrch.ListVisible Then
ItemSrch.ShowList 490, 10
If ActiveControl.Name = "ItemGrid" Then ItemGrid.SetFocus
End If
Else
If ItemSrch.ListVisible Then ItemSrch.HideList
End If
End If
End Sub
Private Sub ItemGrid_EditorChange()
If ItemGrid.Col = 1 Then
ItemSrch.SearchValue ItemGrid.Text
End If
End Sub
Private Sub ItemGrid_KeyDown(KeyCode As Integer, Shift As Integer)
If Not (ADDMode Or EditMode) Or Shift = 0 Then Exit Sub
If KeyCode = 40 Then
If Shift = vbCtrlMask Then ItemSrch.MoveNext
ElseIf KeyCode = 38 Then
If Shift = vbCtrlMask Then ItemSrch.MovePrevious
End If
End Sub
Private Function GetVoucherID() As String
Dim RS As New ADODB.Recordset
RS.Open "Select Max(SNO) From Voucher", Conn, adOpenDynamic, adLockOptimistic
If Not RS.EOF Then GetVoucherID = GetProperCode(IIf(IsNull(RS(0)), "1", RS(0) + 1), 6) Else GetVoucherID = GetProperCode("1", 6)
End Function
Private Function GetLedgerID() As String
Dim RS As New ADODB.Recordset
RS.Open "Select Max(ID) From LEDGER", Conn, adOpenDynamic, adLockOptimistic
If Not RS.EOF Then GetLedgerID = GetProperCode(IIf(IsNull(RS(0)), "1", RS(0) + 1), 6) Else GetLedgerID = GetProperCode("1", 6)
End Function