Next Chapter 55 Sales Form

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