Next Chapter 43 Item Opening
PROJECT SOURCE CODE
SPONSORED LINKS
Item Opening
'******************************************************************
'******************************************************************
'** Author : Samee Ullah Siddiqui
'** Subject : Opening of Items
'** Date : Saturday, August, 30, 2003
'** Modified : Monday, September, 01, 2003
'******************************************************************
'******************************************************************
Dim ADDMode As Boolean
Dim EditMode As Boolean
Dim EmptyTable As Boolean
Dim VoucherType As String
Dim OpRst 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
VNoTxt = GetVoucherCode()
Conn.BeginTrans
End Sub
Private Sub CancelCmd_Click()
Conn.RollbackTrans
ADDMode = False
EditMode = False
Call SetControls
End Sub
Private Sub DelCmd_Click()
If VNoTxt = "" 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
OpRst.Requery
ADDMode = False
EditMode = False
Call SetControls
Call SetFieldsValues(OpRst)
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 ItemGrid_LostFocus()
TotalLbl.Caption = Format(SumOfValues(6), NumFormat)
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
If (Me.ActiveControl.Name = "ItemGrid") Then Exit Sub
If (EditMode And Me.ActiveControl.Name = "VNoTxt") 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") * 55 'PARTICULARS
.ColWidth(2) = TextWidth("A") * 8 'Packing
.ColWidth(3) = TextWidth("A") * 8 '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
.ColWidth(10) = TextWidth("A") * 0 'Batch Number
.ColWidth(11) = TextWidth("A") * 0 'Exp Date
.ColWidth(12) = TextWidth("A") * 0 'Mfg Date
.ColWidth(13) = TextWidth("A") * 0 'Free
.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_Load()
Me.Caption = Label1(1).Caption
TxtType.Text = "Medicine"
Call TxtType_Click
Set Conn = New ADODB.Connection
Conn.mode = adModeReadWrite
Conn.CursorLocation = adUseClient
Conn.Open ShapeConnectString
If Expiry = False Or TxtType.Text = "Other" Then Call SetGridProps Else Call SetGridPropsForMedicine
Set OpRst = New ADODB.Recordset
OpRst.CursorLocation = adUseClient
Dim SQL As String
SQL = "SHAPE {SELECT DISTINCT Ledger.VNO, VTYPE, VDATE, SUM(RATE * QTY) AS AMOUNT FROM Ledger WHERE Ledger.VTYPE='OP' GROUP BY VNO, VTYPE, VDATE Order By VNO DESC} AS OPVoucher APPEND ({SELECT Ledger.VTYPE, Ledger.VNO, Ledger.ICODE, ITEM.Item_Desc, Ledger.QTY , Ledger.Free, 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"
OpRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
If OpRst.RecordCount > 0 Then
Call SetFieldsValues(OpRst)
Else
EmptyTable = True
End If
Call SetControls
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
OpRst.Close
Set OpRst = 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()
ItemFrame.Enabled = (ADDMode Or EditMode)
AddCmd.Enabled = Not (ADDMode Or EditMode)
EditCmd.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)
ExitCmd.Enabled = Not (ADDMode Or EditMode)
ExitCmd.Cancel = Not (ADDMode Or EditMode)
ItemGrid.ShowEditor = (ADDMode Or EditMode)
If Not (ADDMode Or EditMode) Then ItemSrch.HideList
If Not (ADDMode Or EditMode) Then VnoSrch.HideList
If (ADDMode Or EditMode) Then
ItemGrid.Col = 1
ItemGrid.Row = IIf(ADDMode, 1, ItemGrid.Rows - 1)
End If
Set VnoSrch.BoundTextBox = IIf(EditMode, VNoTxt, Nothing)
TopCmd.Enabled = (Not (EmptyTable Or ADDMode Or EditMode)) And (OpRst.AbsolutePosition > 1)
PrevCmd.Enabled = (Not (EmptyTable Or ADDMode Or EditMode)) And (OpRst.AbsolutePosition > 1)
NextCmd.Enabled = (Not (EmptyTable Or ADDMode Or EditMode)) And (OpRst.AbsolutePosition < OpRst.RecordCount)
LastCmd.Enabled = (Not (EmptyTable Or ADDMode Or EditMode)) And (OpRst.AbsolutePosition < OpRst.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
If ItemGrid.Row > (ItemGrid.FixedRows) And ItemGrid.TextMatrix(ItemGrid.Row, 1) = "" Then ItemGrid.TextMatrix(ItemGrid.Row, 1) = ItemGrid.TextMatrix(ItemGrid.Row - 1, 1)
Call SelectText(ItemGrid.GridTextBox)
ItemSrch.SearchValue ItemGrid.Text
Else
Call SelectText(ItemGrid.GridTextBox)
End If
End Sub
Public Sub LeaveCell()
Dim rst As ADODB.Recordset
If Not (ADDMode Or EditMode) Then Exit Sub
If ItemGrid.Col = 1 Then
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
ElseIf ItemGrid.Col = 4 Or ItemGrid.Col = 13 Then
Dim vQty As Integer
If ADDMode Then
ItemGrid.TextMatrix(ItemGrid.Row, 3) = Val(ItemGrid.TextMatrix(ItemGrid.Row, 8)) + Val(ItemGrid.TextMatrix(ItemGrid.Row, 4)) + Val(ItemGrid.TextMatrix(ItemGrid.Row, 13))
Else
vQty = Val(ItemGrid.TextMatrix(ItemGrid.Row, 8)) - Val(ItemGrid.TextMatrix(ItemGrid.Row, 9)) - Val(ItemGrid.TextMatrix(ItemGrid.Row, 13)) 'vQty = Stock - OldQuantity - Free Qty
ItemGrid.TextMatrix(ItemGrid.Row, 3) = vQty + Val(ItemGrid.TextMatrix(ItemGrid.Row, 4)) + Val(ItemGrid.TextMatrix(ItemGrid.Row, 13)) 'Stock = vQty + NewQuantity + Free Qty
End If
ElseIf (ItemGrid.Col = 5 Or ItemGrid.Col = 6) Then
ItemGrid.TextMatrix(ItemGrid.Row, 6) = AmountValue(ItemGrid.TextMatrix(ItemGrid.Row, 4), ItemGrid.TextMatrix(ItemGrid.Row, 5))
Call ItemGrid_LostFocus
If TxtType.Text = "Other" Then SendKeys "{ENTER}": SendKeys "{ENTER}"
End If
If Expiry = True Or TxtType.Text = "Medicine" Then Call LeaveCellForMedicine
End Sub
Private Sub ItemGrid_LeaveCell()
On Error GoTo ErHand
LeaveCell
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 "ItemOPFrm.ItemGrid_LeaveCell"
End If
End Sub
Private Sub ItemGrid_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not EditMode Then Exit Sub
' If Button = 2 Then PopupMenu FrmMDI.MnDelRow, , ItemGrid.Left + X, ItemGrid.Top + Y
End Sub
Private Sub LastCmd_Click()
LastMove OpRst
Call SetFieldsValues(OpRst)
Call SetControls
End Sub
Private Sub TxtType_Click()
With ItemSrch
.DBConnectString = ConnectString
If Expiry = False Or TxtType.Text = "Other" Then
.SQLString = "SELECT ItemCode, Item_Desc + space(3) + ' -> Packing =' + Packing FROM ITEM where IGCode <> '0001'"
Call SetGridProps
Else
.SQLString = "SELECT ItemCode, Item_Desc + space(3) + ' -> Packing =' + Packing FROM ITEM where IGCode = '0001'"
Call SetGridPropsForMedicine
End If
.PopulateList
End With
With VnoSrch
.DBConnectString = ConnectString
.SQLString = "SELECT DISTINCT Ledger.VNO, Ledger.VNO FROM Ledger WHERE Ledger.VTYPE='OP'"
.PopulateList
End With
End Sub
Private Sub VNoTxt_GotFocus()
SelectText VNoTxt
End Sub
Private Sub VNoTxt_Validate(Cancel As Boolean)
If Not (ADDMode) Then Exit Sub
If Len(Trim(VNoTxt)) <> 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 PURCHASE WHERE VNO = '" & VNoTxt & "'"
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 OpRst
Call SetFieldsValues(OpRst)
Call SetControls
End Sub
Private Sub PrevCmd_Click()
PreviousMove OpRst
Call SetFieldsValues(OpRst)
Call SetControls
End Sub
Private Sub SaveCmd_Click()
If Not SavedData Then Exit Sub
Conn.CommitTrans
If ADDMode And VNoTxt <> "" Then
VnoSrch.AddItem VNoTxt & "|" & VNoTxt
EmptyTable = False
Else
VnoSrch.PopulateList
End If
OpRst.Requery
If EditMode And Not IsEmpty(Bmark) Then OpRst.Bookmark = Bmark
Call SetFieldsValues(OpRst)
ADDMode = False
EditMode = False
Call SetControls
End Sub
Private Function SavedData() As Boolean
On Error GoTo ErrHand
If Not ValidateData Then Exit Function
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
VoucherNo = IIf(ADDMode, GetVoucherCode(), VNoTxt.Text)
Dim LgrRst As New ADODB.Recordset
LgrRst.CursorLocation = adUseClient
'Saving data to ledger table
If EditMode Then
SQL = "SELECT * FROM LEDGER WHERE VTYPE = 'OP' AND VNO = '" & VoucherNo & "'"
LgrRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
Do Until LgrRst.EOF
SQL = "UPDATE ITEMSIZE SET STOCK = STOCK - " & IIf(IsNull(LgrRst!Qty), 0, LgrRst!Qty) - IIf(IsNull(LgrRst!free), 0, LgrRst!free) & " WHERE ICODE = '" & LgrRst!ICODE & "' AND ISIZE = " & LgrRst!ISIZE
Conn.Execute SQL
LgrRst.MoveNext
Loop
SQL = "DELETE FROM LEDGER WHERE VTYPE = 'OP' 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!VType = "OP"
LgrRst!ID = GetVoucherID()
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)
If Expiry = True And TxtType.Text = "Medicine" Then LgrRst!free = .TextMatrix(i, 13)
LgrRst.Update
If Expiry = True And TxtType.Text = "Medicine" Then Conn.Execute ("insert into PurchaseDetail values('" & VoucherNo & "','" & "OP" & "','" & .TextMatrix(i, 7) & "','" & .TextMatrix(i, 11) & "','" & .TextMatrix(i, 12) & "','" & .TextMatrix(i, 4) & "','" & .TextMatrix(i, 10) & "')")
SQL = "UPDATE ITEMSIZE SET STOCK = STOCK + " & Val(.TextMatrix(i, 4)) + Val(.TextMatrix(i, 13)) & " 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 ItemOPFrm.SavedData"
End Function
Private Function ValidateData() As Boolean
If 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 Or ItemGrid.Col = 5 Or ItemGrid.Col = 13 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
RS.Open "Select Max(VNO) From LEDGER WHERE VTYPE = 'OP'", Conn, adOpenDynamic, adLockOptimistic
If Not RS.EOF Then GetVoucherCode = GetProperCode(IIf(IsNull(RS(0)), "1", Mid(RS(0), 2) + 1), 6) Else GetVoucherCode = GetProperCode("1", 6)
End Function
Private Sub TopCmd_Click()
TopMove OpRst
Call SetFieldsValues(OpRst)
Call SetControls
End Sub
Private Sub SetFieldsValues(ByVal rst As ADODB.Recordset)
Dim rstDetail As New ADODB.Recordset
Dim ItemDetailString As String
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
VNoTxt = rst!Vno
VoucherDate = rst!vDate
DayLbl = Format(rst!vDate, "dddd")
TotalLbl = Format(rst!amount, NumFormat)
Set ItemRst = rst("Items").UnderlyingValue
Set rstDetail = New ADODB.Recordset
rstDetail.Open "select * from PurchaseDetail Where VType='" & ItemRst!VType & "' And VNO='" & ItemRst!Vno & "'", Conn, adOpenDynamic, adLockBatchOptimistic
If Not rstDetail.EOF Then TxtType.Text = "Medicine" Else TxtType.Text = "Other"
Call TxtType_Click
ItemGrid.Rows = 1
If Not (ItemRst.RecordCount > 0) Then
ItemGrid.AddItem "" 'Add a blank row if Item not found
Exit Sub
End If
Do Until ItemRst.EOF
Set rstDetail = New ADODB.Recordset
rstDetail.Open "select * from PurchaseDetail Where VType='" & ItemRst!VType & "' And VNO='" & ItemRst!Vno & "' And ProductCode='" & ItemRst!ICODE & "'", Conn, adOpenDynamic, adLockBatchOptimistic
If Not rstDetail.EOF Then
ItemDetailString = vbTab & rstDetail!BatchNo & vbTab & Format(rstDetail!ExpDate, "dd-mm-yyyy") & vbTab & Format(rstDetail!Mfgdate, "dd-mm-yyyy") & vbTab & ItemRst!free
End If
ItemString = ItemRst.AbsolutePosition & vbTab
ItemString = ItemString & ItemRst!ITEM_DESC & vbTab
ItemString = ItemString & ItemRst!ISIZE & vbTab
ItemString = ItemString & ItemRst!STOCK & vbTab
ItemString = ItemString & ItemRst!Qty & vbTab
ItemString = ItemString & ItemRst!Rate & vbTab
ItemString = ItemString & Format(ItemRst!amount, NumFormat) & vbTab
ItemString = ItemString & ItemRst!ICODE & vbTab
ItemString = ItemString & ItemRst!STOCK & vbTab
ItemString = ItemString & ItemRst!Qty
ItemString = ItemString & ItemDetailString
ItemGrid.AddItem ItemString
ItemRst.MoveNext
Loop
ItemGrid.RefreshEditor
End Sub
Private Sub ClearFields()
VNoTxt = ""
VoucherDate = Date
DayLbl = ""
TotalLbl = ""
If Expiry = False Or TxtType.Text = "Other" Then Call SetGridProps Else Call SetGridPropsForMedicine
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()
On Error Resume Next
Dim BeforeSearchBmark
BeforeSearchBmark = OpRst.Bookmark
OpRst.MoveFirst
OpRst.Find "VNO='" & VNoTxt & "'"
If OpRst.EOF Then
MsgBox "Voucher No. not found.", vbCritical, "Invalid Voucher No."
OpRst.Bookmark = BeforeSearchBmark
Else
Bmark = OpRst.Bookmark
Call SetFieldsValues(OpRst)
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 = 'OP' AND VNO = '" & VNoTxt & "'"
LgrRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
Do Until LgrRst.EOF
SQL = "UPDATE ITEMSIZE SET STOCK = STOCK - " & IIf(IsNull(LgrRst!Qty), 0, LgrRst!Qty) & " - " & IIf(IsNull(LgrRst!free), 0, LgrRst!free) & " WHERE ICODE = '" & LgrRst!ICODE & "' AND ISIZE = " & LgrRst!ISIZE
Conn.Execute SQL
LgrRst.MoveNext
Loop
'Delete from Ledger
SQL = "DELETE FROM LEDGER WHERE VTYPE = 'OP' AND VNO = '" & VNoTxt & "'"
Conn.Execute SQL
'Delete From Medicine Detail Table
SQL = "DELETE FROM PurchaseDetail WHERE VTYPE = 'OP' AND VNO = '" & VNoTxt & "'"
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
'***************************************** EnhanceMent By Sameeullah *********************
Private Sub SetGridPropsForMedicine(Optional Rows As Integer)
With ItemGrid
.Clear
.FormatString = "S No.|<Item Particulars|>Packing|>Stock|>Qty|>Rate|>Amount|IID|Stock|OldQty|>BatchNo|>Exp. Date|>Mfg. Date|>Free"
.Rows = IIf(Rows <= 1, 2, Rows)
.ColWidth(1) = TextWidth("A") * 40 'PARTICULARS
.ColWidth(2) = TextWidth("A") * 8 'Packing
.ColWidth(3) = TextWidth("A") * 8 '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
.ColWidth(10) = TextWidth("A") * 8 'Batch Number
.ColWidth(11) = TextWidth("A") * 10 'Exp Date
.ColWidth(12) = TextWidth("A") * 10 'Mfg Date
.ColWidth(13) = TextWidth("A") * 8 'Free
.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
ItemGrid.Refresh
End Sub
Public Sub LeaveCellForMedicine()
If ItemGrid.Col = 1 And Not ItemSrch.SelectedCompany = "" Then
ItemGrid.TextMatrix(ItemGrid.Row, 11) = Format(Date, "dd-MMM-yyyy")
ItemGrid.TextMatrix(ItemGrid.Row, 12) = Format(Date, "dd-MMM-yyyy")
ElseIf ItemGrid.Col = 11 Then
If IsDate(ItemGrid.TextMatrix(ItemGrid.Row, 11)) = False Then MsgBox "Invalid Expire Date,Please Enter Date Like [01-JUN-2004]", vbCritical + vbDefaultButton1
ElseIf ItemGrid.Col = 12 Then
If IsDate(ItemGrid.TextMatrix(ItemGrid.Row, 12)) = False Then MsgBox "Invalid Mfg. Date,Please Enter Date Like [01-JUN-2004]", vbCritical + vbDefaultButton1
End If
End Sub
Private Function GetVoucherID() As String
Dim RS As New ADODB.Recordset
RS.Open "Select Max(ID) From LEDGER", 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
Sponsored Links