📄 frmloadingae.frm
字号:
Private Sub btnLoad_Click()
Dim CurrRow As Integer
CurrRow = getFlexPos(Grid, 11, dcProd.BoundText)
'Add to grid
With Grid
If CurrRow < 0 Then
'Perform if the record is not exist
If .Rows = 2 And .TextMatrix(1, 11) = "" Then
.TextMatrix(1, 1) = dcProd.Text
.TextMatrix(1, 2) = txtEntry(1).Text
.TextMatrix(1, 3) = txtUC.Text
.TextMatrix(1, 4) = txtEntry(2).Text
.TextMatrix(1, 5) = txtEntry(3).Text
.TextMatrix(1, 6) = txtEntry(4).Text
.TextMatrix(1, 7) = txtLQty.Text
.TextMatrix(1, 8) = txtVIQty.Text
.TextMatrix(1, 9) = txtQty.Text
.TextMatrix(1, 10) = txtAmount.Text
.TextMatrix(1, 11) = dcProd.BoundText
Else
.Rows = .Rows + 1
.TextMatrix(.Rows - 1, 1) = dcProd.Text
.TextMatrix(.Rows - 1, 2) = txtEntry(1).Text
.TextMatrix(.Rows - 1, 3) = txtUC.Text
.TextMatrix(.Rows - 1, 4) = txtEntry(2).Text
.TextMatrix(.Rows - 1, 5) = txtEntry(3).Text
.TextMatrix(.Rows - 1, 6) = txtEntry(4).Text
.TextMatrix(.Rows - 1, 7) = txtLQty.Text
.TextMatrix(.Rows - 1, 8) = txtVIQty.Text
.TextMatrix(.Rows - 1, 9) = txtQty.Text
.TextMatrix(.Rows - 1, 10) = txtAmount.Text
.TextMatrix(.Rows - 1, 11) = dcProd.BoundText
.Row = .Rows - 1
End If
'Increase the record count
clRowCount = clRowCount + 1
Else
'Perform if the record already exist
If MsgBox("Product already loaded.Do you want to replace it?", vbQuestion + vbYesNo) = vbYes Then
.Row = CurrRow
'Restore back the collected amount
clAmount = clAmount - toNumber(Grid.TextMatrix(.RowSel, 10))
txtCLAmount.Text = toMoney(clAmount)
.TextMatrix(CurrRow, 1) = dcProd.Text
.TextMatrix(CurrRow, 2) = txtEntry(1).Text
.TextMatrix(CurrRow, 3) = txtUC.Text
.TextMatrix(CurrRow, 4) = txtEntry(2).Text
.TextMatrix(CurrRow, 5) = txtEntry(3).Text
.TextMatrix(CurrRow, 6) = txtEntry(4).Text
.TextMatrix(CurrRow, 7) = txtLQty.Text
.TextMatrix(CurrRow, 8) = txtVIQty.Text
.TextMatrix(CurrRow, 9) = txtQty.Text
.TextMatrix(CurrRow, 10) = txtAmount.Text
.TextMatrix(CurrRow, 11) = dcProd.BoundText
Else
Exit Sub
End If
End If
'Add the amount to current load amount
clAmount = clAmount + toNumber(txtAmount.Text)
txtCLAmount.Text = Format$(clAmount, "#,##0.00")
'Highlight the current row's column
.ColSel = 11
'Display a remove button
Grid_Click
'Reset the entry fields
ResetEntry
End With
End Sub
Private Sub btnPick_Click()
If MsgBox("This will get and display the quantity of the selected product from van inventory." & vbCrLf & "Do you want to continue?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
If LLFK = 0 Then
MsgBox "You did not select your last loading date.In order to get the qty of your van inventory close this form and try to add new record again and then select your last loading date from a drop-down list.", vbExclamation
Else
Dim tRS As New Recordset
tRS.Open "SELECT * FROM qry_IC_VanInvDetails WHERE LLFK=" & LLFK, CN, adOpenStatic, adLockReadOnly
If tRS.RecordCount > 0 Then
txtEntry(5).Text = toNumber(tRS![SoldCases])
txtEntry(6).Text = toNumber(tRS![SoldBoxes])
txtEntry(7).Text = toNumber(tRS![SoldPieces])
MsgBox "The quantity of the product from your van inventory has been loaded.", vbInformation
Else
MsgBox "Unable to find the selected product from your van inventory.", vbExclamation
dcProd.SetFocus
End If
tRS.Close
Set tRS = Nothing
End If
End Sub
Private Sub btnProdAvailable_Click()
'Display Product Stock Info
frmStockViewer.show vbModal
End Sub
Private Sub btnRemove_Click()
'Remove selected load product
With Grid
'Update amount to current load amount
clAmount = clAmount - toNumber(Grid.TextMatrix(.RowSel, 10))
txtCLAmount.Text = Format$(clAmount, "#,##0.00")
'Update the record count
clRowCount = clRowCount - 1
If .Rows = 2 Then Grid.Rows = Grid.Rows + 1
.RemoveItem (.RowSel)
End With
btnRemove.Visible = False
Grid_Click
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdSave_Click()
'Verify the entries
If dcVan.BoundText = "" Then
MsgBox "Please select a van in the list.", vbExclamation
dcVan.SetFocus
Exit Sub
End If
If clRowCount < 1 Then
MsgBox "Please load a product first before you can save this record.", vbExclamation
dcProd.SetFocus
Exit Sub
End If
If MsgBox("This save the record.Do you want to proceed?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
Screen.MousePointer = vbHourglass
Dim RSDetails As New Recordset
Dim EntryIsOK As Boolean
Dim ProdPK As Long 'Product Primary Key
Dim tC As Long 'Temporary Case - Based on actual product quantity
Dim tB As Long 'Temporary Box --^
Dim tP As Long 'Temporary Pieces --^
EntryIsOK = True
RSDetails.CursorLocation = adUseClient
RSDetails.Open "SELECT * FROM tbl_IC_LoadingDetails WHERE LoadingFK=" & PK, CN, adOpenStatic, adLockOptimistic
Dim c As Integer
On Error GoTo err
CN.BeginTrans
'Save the record
With rs
If State = adStateAddMode Or State = adStatePopupMode Then
.AddNew
![PK] = PK
![DateAdded] = Now
![AddedByFK] = CurrUser.USER_PK
Else
![DateModified] = Now
![LastUserFK] = CurrUser.USER_PK
End If
![LoadingNo] = txtEntry(0).Text
![Date] = dtpDate.Value
![VanFK] = dcVan.BoundText
.Update
End With
With Grid
'Save the details of the records
For c = 1 To clRowCount
.Row = c
If State = adStateAddMode Or State = adStatePopupMode Then
ProdPK = toNumber(.TextMatrix(c, 11))
tC = toNumber(getValueAt("SELECT PK,Cases FROM tbl_IC_Products WHERE PK=" & ProdPK, "Cases"))
tB = toNumber(getValueAt("SELECT PK,Boxes FROM tbl_IC_Products WHERE PK=" & ProdPK, "Boxes"))
tP = toNumber(getValueAt("SELECT PK,Pieces FROM tbl_IC_Products WHERE PK=" & ProdPK, "Pieces"))
If toNumber(.TextMatrix(c, 4)) > tC Then EntryIsOK = False: .Col = 4: .CellForeColor = &HFF&: .CellFontBold = True
If toNumber(.TextMatrix(c, 5)) > tB Then EntryIsOK = False: .Col = 5: .CellForeColor = &HFF&: .CellFontBold = True
If toNumber(.TextMatrix(c, 6)) > tP Then EntryIsOK = False: .Col = 6: .CellForeColor = &HFF&: .CellFontBold = True
RSDetails.AddNew
RSDetails![PK] = getIndex("tbl_IC_LoadingDetails")
RSDetails![LoadingFK] = PK
RSDetails![ProductFK] = ProdPK
RSDetails![UnitCost(Each)] = toNumber(.TextMatrix(c, 3))
RSDetails![Cases] = toNumber(.TextMatrix(c, 4))
RSDetails![Boxes] = toNumber(.TextMatrix(c, 5))
RSDetails![Pieces] = toNumber(.TextMatrix(c, 6))
RSDetails![QtyLoad] = toNumber(.TextMatrix(c, 7))
RSDetails![VanInv] = toNumber(.TextMatrix(c, 8))
RSDetails.Update
'Update stock value
ChangeValue CN, "tbl_IC_Products", "Cases", tC - toNumber(.TextMatrix(c, 4)), True, "WHERE PK=" & ProdPK
ChangeValue CN, "tbl_IC_Products", "Boxes", tB - toNumber(.TextMatrix(c, 5)), True, "WHERE PK=" & ProdPK
ChangeValue CN, "tbl_IC_Products", "Pieces", tP - toNumber(.TextMatrix(c, 6)), True, "WHERE PK=" & ProdPK
End If
Next c
End With
'Clear variables
c = 0
ProdPK = 0
tC = 0
tB = 0
tP = 0
Set RSDetails = Nothing
If EntryIsOK = True Then
CN.CommitTrans
Else
CN.RollbackTrans
MsgBox "Some product/s have not enough quantity to serve for this loading." & vbCrLf & _
"Please check the stock value of the loaded products with red color in the list.", vbExclamation
Grid.Row = 1
Grid.Col = 0
'Grid.ColSel = 11
Grid.SetFocus
Screen.MousePointer = vbDefault
Exit Sub
End If
HaveAction = True
Screen.MousePointer = vbDefault
If State = adStateAddMode Then
MsgBox "New record has been successfully saved.", vbInformation
If MsgBox("Do you want to add another new record?", vbQuestion + vbYesNo) = vbYes Then
ResetFields
GeneratePK
Else
Unload Me
End If
Else
MsgBox "Changes in record has been successfully saved.", vbInformation
Unload Me
End If
Exit Sub
err:
CN.RollbackTrans
prompt_err err, Name, "cmdSave_Click"
Screen.MousePointer = vbDefault
End Sub
Private Sub cmdUsrHistory_Click()
On Error Resume Next
Dim tDate1 As String
Dim tUser1 As String
tDate1 = Format$(rs.Fields("DateAdded"), "MMM-dd-yyyy HH:MM AMPM")
tUser1 = getValueAt("SELECT PK,CompleteName FROM tbl_SM_Users WHERE PK = " & rs.Fields("AddedByFK"), "CompleteName")
MsgBox "Date Added: " & tDate1 & vbCrLf & _
"Added By: " & tUser1 & vbCrLf & _
"" & vbCrLf & _
"Last Modified: n/a" & vbCrLf & _
"Modified By: n/a", vbInformation, "Modification History"
tDate1 = vbNullString
tUser1 = vbNullString
End Sub
Private Sub dcProd_Click(Area As Integer)
On Error Resume Next
If Area = 2 Then
If dcProd.BoundText <> "" Then
ResetEntry
DiplayProdInfo
End If
End If
End Sub
Private Sub Form_Activate()
On Error Resume Next
If CloseMe = True Then Unload Me: Exit Sub
txtEntry(0).SetFocus
End Sub
Private Sub Form_Load()
dtpDate.Value = Date
'Bind the data combo
bind_dc "SELECT * FROM tbl_AR_Van", "VanName", dcVan, "PK", True
InitGrid
'Check the form state
If State = adStateAddMode Or State = adStatePopupMode Then
frmLoadingAEPickFrom.show vbModal
'Set the recordset
rs.Open "SELECT * FROM tbl_IC_Loading WHERE PK=" & PK, CN, adOpenStatic, adLockOptimistic
'Bind the combo
bind_dc "SELECT * FROM tbl_IC_Products", "ProductCode", dcProd, "PK", True
Caption = "Create New Entry"
cmdUsrHistory.Enabled = False
GeneratePK
DiplayProdInfo
Else
Screen.MousePointer = vbHourglass
'Set the recordset
rs.Open "SELECT * FROM qry_IC_Loading WHERE PK=" & PK, CN, adOpenStatic, adLockOptimistic
Caption = "View Record"
cmdCancel.Caption = "Close"
cmdUsrHistory.Enabled = True
btnProdAvailable.Enabled = False
txtEntry(0).Width = txtDate.Width
DisplayForViewing
MsgBox "This is use for viewing the record only." & vbCrLf & _
"You cannot perform any changes in this form." & vbCrLf & vbCrLf & _
"Note:If you have mistake in adding this record then " & vbCrLf & _
"void this record and re-enter.", vbExclamation
Screen.MousePointer = vbDefault
End If
End Sub
'Procedure used to generate PK
Private Sub GeneratePK()
PK = getIndex("tbl_IC_Loading")
txtEntry(0).Text = GenerateID(PK, Format$(Date, "yyyy") & Format$(Date, "mm") & Format$(Date, "dd") & "-", "0")
End Sub
'Procedure used to initialize the grid
Private Sub InitGrid()
clRowCount = 0
With Grid
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -