📄 frmforwardersguideae.frm
字号:
Dim RSReceive As New Recordset
RSReceive.CursorLocation = adUseClient
RSReceive.Open "SELECT * FROM Forwarders WHERE ForwarderID=" & ForwarderPK, CN, adOpenStatic, adLockOptimistic
Screen.MousePointer = vbHourglass
Dim c As Integer
DeleteItems
'Save the record
With RSReceive
If State = adStateAddMode Or State = adStatePopupMode Then
.AddNew
ForwarderPK = getIndex("Forwarders")
![ForwarderID] = ForwarderPK
![POID] = PK
![DateAdded] = Now
![AddedByFK] = CurrUser.USER_PK
End If
![ShippingCompanyID] = IIf(nsdShippingCo.BoundText = "", nsdShippingCo.Tag, nsdShippingCo.BoundText)
![ShippingGuideNo] = txtShippingGuideNo.Text
' ![Ship] = txtShip.Text
![Class] = cboClass.ListIndex
![LocalForwarderID] = IIf(nsdLocal.BoundText = "", nsdLocal.Tag, nsdLocal.BoundText)
![DeliveryDate] = dtpDeliveryDate.Value
![ReceiptDate] = dtpReceiptDate.Value
![Ref] = cboRef.Text
![RefNo] = txtRefNo.Text
' ![TruckNo] = txtTruckNo.Text
' ![VanNo] = txtVanNo.Text
' ![VoyageNo] = txtVoyageNo.Text
![PickupLocation] = txtPickupLocation.Text
![PickupDate] = dtpPickupDate.Value
![Status] = IIf(cboStatus.Text = "Received", True, False)
![Notes] = txtNotes.Text
![Gross] = toNumber(txtGross(2).Text)
![Discount] = txtDesc.Text
![TaxBase] = toNumber(txtTaxBase.Text)
![Vat] = toNumber(txtVat.Text)
![NetAmount] = toNumber(txtNet.Text)
' ![Freight] = txtFreight.Text
' ![Arrastre] = txtArrastre.Text
![DateModified] = Now
![LastUserFK] = CurrUser.USER_PK
.Update
End With
' If cboStatus.Text = "Received" Then
' 'Connection for Vendors_Ledger
' Dim RSLedger As New Recordset
'
' With RSLedger
' .CursorLocation = adUseClient
' .Open "SELECT * FROM Vendors_Ledger WHERE ForwarderID=" & ForwarderPK & " AND BillType = 'Products'", CN, adOpenStatic, adLockOptimistic
'
' .AddNew
'
' !ForwarderID = ForwarderPK
'
' !VendorID = txtSupplier.Tag
' !RefNo = txtRefNo.Text
' !Date = Date
' !Debit = txtGross(2).Text
' !BillType = "Products"
'
' .Update
'
' '-------------------------
' 'Save freight
' .Close
' .Open "SELECT * FROM Vendors_Ledger WHERE ForwarderID=" & ForwarderPK & " AND BillType = 'Freight'", CN, adOpenStatic, adLockOptimistic
'
' 'Save bill to Vendors_Ledger table
' If cboFreightAgreement.Text = "By supplier until freight" Then
' If cboFreightPeriod.Text = "Postpaid" Then
' .AddNew
'
' !ForwarderID = ForwarderPK
'
' !Credit = txtFreight.Text
'
' CN.Execute "INSERT INTO Shipping_Company_Ledger ( ShippingCompanyID, ForwarderID, RefNo, [Date], Debit ) " _
' & "VALUES (" & nsdShippingCo.Tag & ", " & ForwarderPK & ", " & txtRefNo.Text & ", #" & Date & "#, " & toNumber(txtFreight.Text) & ")"
' End If
'
' CN.Execute "INSERT INTO Local_Forwarder_Ledger ( ForwarderID, [Date], Debit ) " _
' & "VALUES (" & ForwarderPK & ",#" & Date & "#, " & txtArrastre.Text & ")"
' ElseIf cboFreightAgreement.Text = "By supplier until local arrastre" Then
' If cboFreightPeriod.Text = "Postpaid" Then
' .AddNew
'
' !ForwarderID = ForwarderPK
'
' !Credit = toMoney(txtFreight.Text) + toMoney(txtArrastre.Text)
'
' CN.Execute "INSERT INTO Shipping_Company_Ledger ( ShippingCompanyID, ForwarderID, RefNo, [Date], Debit ) " _
' & "VALUES (" & nsdShippingCo.Tag & ", " & ForwarderPK & ", " & txtRefNo.Text & ",#" & Date & "#, " & toNumber(txtFreight.Text) & ")"
' End If
' ElseIf cboFreightAgreement.Text = "Half until freight" Then
' .AddNew
'
' !ForwarderID = ForwarderPK
'
' !VendorID = txtSupplier.Tag
' !Date = Date
' !BillType = "Freight"
'
' If cboFreightPeriod.Text = "Prepaid" Then
' !Dedit = toMoney(txtFreight.Text) / 2
' Else 'Postpaid
' !Credit = toMoney(txtFreight.Text) / 2
'
' CN.Execute "INSERT INTO Shipping_Company_Ledger ( ShippingCompanyID, ForwarderID, RefNo, [Date], Debit ) " _
' & "VALUES (" & nsdShippingCo.Tag & ", " & ForwarderPK & ", " & txtRefNo.Text & ", #" & Date & "#, " & toNumber(txtFreight.Text) & ")"
' End If
'
' CN.Execute "INSERT INTO Local_Forwarder_Ledger ( ForwarderID, [Date], Debit ) " _
' & "VALUES (" & ForwarderPK & ",#" & Date & "#, " & txtArrastre.Text & ")"
'
' .Update
' ElseIf cboFreightAgreement.Text = "Half until local arrastre" Then
' .AddNew
'
' !ForwarderID = ForwarderPK
'
' !VendorID = txtSupplier.Tag
' !Date = Date
' !BillType = "Freight"
'
' If cboFreightPeriod.Text = "Prepaid" Then
' !Dedit = (toMoney(txtFreight.Text) + toMoney(txtArrastre.Text)) / 2
' Else 'Postpaid
' !Credit = (toMoney(txtFreight.Text) + toMoney(txtArrastre.Text)) / 2
'
' CN.Execute "INSERT INTO Shipping_Company_Ledger ( ShippingCompanyID, ForwarderID, RefNo, [Date], Debit ) " _
' & "VALUES (" & nsdShippingCo.Tag & ", " & ForwarderPK & ", " & txtRefNo.Text & ", #" & Date & "#, " & toNumber(txtFreight.Text) & ")"
'
' CN.Execute "INSERT INTO Local_Forwarder_Ledger ( ForwarderID, [Date], Debit ) " _
' & "VALUES (" & ForwarderPK & ",#" & Date & "#, " & toNumber(txtArrastre.Text) & ")"
' End If
'
' .Update
' ElseIf cboFreightAgreement.Text = "By VTM" Then
' CN.Execute "INSERT INTO Shipping_Company_Ledger ( ShippingCompanyID, ForwarderID, RefNo, [Date], Debit ) " _
' & "VALUES (" & nsdShippingCo.Tag & ", " & ForwarderPK & ", " & txtRefNo.Text & ", #" & Date & "#, " & toNumber(txtFreight.Text) & ")"
'
' CN.Execute "INSERT INTO Local_Forwarder_Ledger ( ForwarderID, [Date], Debit ) " _
' & "VALUES (" & ForwarderPK & ",#" & Date & "#, " & toNumber(txtArrastre.Text) & ")"
' End If
' End With
' End If
'Connection for Forwarders_Detail
Dim RSDetails As New Recordset
RSDetails.CursorLocation = adUseClient
RSDetails.Open "SELECT * FROM Forwarders_Detail WHERE ForwarderID=" & ForwarderPK, CN, adOpenStatic, adLockOptimistic
'Add qty ordered to qty onhand
Dim RSStockUnit As New Recordset
RSStockUnit.CursorLocation = adUseClient
RSStockUnit.Open "SELECT * From Stock_Unit", CN, adOpenStatic, adLockOptimistic
With Grid
'Save the details of the records to Purchase_Order_Receive_Local_Detail
For c = 1 To cIRowCount
.Row = c
If State = adStateAddMode Or State = adStatePopupMode Then
AddNew:
RSDetails.AddNew
RSDetails![ForwarderID] = ForwarderPK
RSDetails![StockID] = toNumber(.TextMatrix(c, 11))
RSDetails![Qty] = toNumber(.TextMatrix(c, 3))
RSDetails![Unit] = getValueAt("SELECT UnitID,Unit FROM Unit WHERE Unit='" & .TextMatrix(c, 4) & "'", "UnitID")
RSDetails![Price] = toNumber(.TextMatrix(c, 5))
RSDetails![DiscPercent] = toNumber(.TextMatrix(c, 7)) / 100
RSDetails![ExtDiscPercent] = toNumber(.TextMatrix(c, 8)) / 100
RSDetails![ExtDiscAmt] = toNumber(.TextMatrix(c, 9))
RSDetails.Update
ElseIf State = adStateEditMode Then
RSDetails.Filter = "StockID = " & toNumber(.TextMatrix(c, 11))
If RSDetails.RecordCount = 0 Then GoTo AddNew
RSDetails![Qty] = toNumber(.TextMatrix(c, 3))
RSDetails![Unit] = getValueAt("SELECT UnitID,Unit FROM Unit WHERE Unit='" & .TextMatrix(c, 4) & "'", "UnitID")
RSDetails![Price] = toNumber(.TextMatrix(c, 5))
RSDetails![DiscPercent] = toNumber(.TextMatrix(c, 7)) / 100
RSDetails![ExtDiscPercent] = toNumber(.TextMatrix(c, 8)) / 100
RSDetails![ExtDiscAmt] = toNumber(.TextMatrix(c, 9))
RSDetails.Update
End If
If cboStatus.Text = "Received" Then
RSStockUnit.Filter = "StockID = " & toNumber(.TextMatrix(c, 11)) & " AND UnitID = " & getValueAt("SELECT UnitID,Unit FROM Unit WHERE Unit='" & .TextMatrix(c, 4) & "'", "UnitID")
RSStockUnit!Pending = RSStockUnit!Pending + toNumber(.TextMatrix(c, 3))
RSStockUnit.Update
End If
Next c
End With
'Clear variables
c = 0
Set RSDetails = Nothing
CN.CommitTrans
blnSave = True
HaveAction = True
Screen.MousePointer = vbDefault
If State = adStateAddMode Or State = adStateEditMode Then
MsgBox "New record has been successfully saved.", vbInformation
Unload Me
End If
Exit Sub
err:
blnSave = False
prompt_err err, Name, "cmdSave_Click"
Screen.MousePointer = vbDefault
End Sub
Private Sub CmdTasks_Click()
PopupMenu mnu_Tasks
End Sub
Private Sub Form_Activate()
On Error Resume Next
If CloseMe = True Then
Unload Me
Else
txtShippingGuideNo.SetFocus
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys ("{tab}")
End Sub
Private Sub Form_Load()
InitGrid
InitNSD
bind_dc "SELECT * FROM Unit", "Unit", dcUnit, "UnitID", True
Screen.MousePointer = vbHourglass
RS.CursorLocation = adUseClient
'Check the form state
If State = adStateAddMode Or State = adStatePopupMode Then
'Set the recordset
RS.Open "SELECT * FROM qry_Purchase_Order WHERE POID=" & PK, CN, adOpenStatic, adLockOptimistic
dtpDeliveryDate.Value = Date
dtpReceiptDate.Value = Date
dtpPickupDate.Value = Date
mnu_History.Enabled = False
mnu_ReceiveItems.Visible = False
txtShippingGuideNo = GeneratePK()
CN.BeginTrans
DisplayForAdding
ElseIf State = adStateEditMode Then
'Set the recordset
RS.Open "SELECT * FROM qry_Forwarders WHERE ForwarderID=" & ForwarderPK, CN, adOpenStatic, adLockOptimistic
' dtpDeliveryDate.Value = Date
mnu_History.Enabled = False
mnu_ReceiveItems.Visible = False
CN.BeginTrans
DisplayForEditing
Else
'Set the recordset
RS.Open "SELECT * FROM qry_Forwarders WHERE ForwarderID=" & ForwarderPK, CN, adOpenStatic, adLockOptimistic
cmdCancel.Caption = "Close"
DisplayForViewing
End If
Screen.MousePointer = vbDefault
'Initialize Graphics
With MAIN
'cmdGenerate.Picture = .i16x16.ListImages(14).Picture
'cmdNew.Picture = .i16x16.ListImages(10).Picture
'cmdReset.Picture = .i16x16.ListImages(15).Picture
End With
End Sub
Private Sub ResetEntry()
txtStock.Text = ""
txtQty.Text = "0"
txtPrice.Tag = 0
txtPrice.Text = "0.00"
txtDiscPercent.Text = "0"
txtExtDiscPerc.Text = "0"
txtExtDiscAmt.Text = "0"
End Sub
Private Sub Form_Unload(Cancel As Integer)
'If HaveAction = True Then
' frmLocalPurchaseReturn.RefreshRecords
'End If
Set frmForwardersGuideAE = Nothing
End Sub
Private Sub Grid_Click()
If State = adStateViewMode Then Exit Sub
With Grid
txtStock.Text = .TextMatrix(.RowSel, 2)
txtStock.Tag = .TextMatrix(.RowSel, 11) 'Create tag to get the StockID
intQtyOld = IIf(.TextMatrix(.RowSel, 3) = "", 0, .TextMatrix(.RowSel, 3))
txtQty = .TextMatrix(.RowSel, 3)
dcUnit.Text = .TextMatrix(.RowSel, 4)
txtPrice = toMoney(.TextMatrix(.RowSel, 5))
txtGross(1) = toMoney(.TextMatrix(.RowSel, 6))
txtDiscPercent.Text = toMoney(.TextMatrix(.RowSel, 7))
txtExtDiscPerc.Text = toMoney(.TextMatrix(.RowSel, 8))
txtExtDiscAmt.Text = toMoney(.TextMatrix(.RowSel, 9))
txtNetAmount = toMoney(.TextMatrix(.RowSel, 10))
If State = adStateViewMode Then Exit Sub
If Grid.Rows = 2 And Grid.TextMatrix(1, 11) = "" Then
btnRemove.Visible = False
Else
btnRemove.Visible = True
btnRemove.Top = (Grid.CellTop + Grid.Top) - 20
btnRemove.Left = Grid.Left + 50
End If
End With
End Sub
Private Sub Grid_Scroll()
btnRemove.Visible = False
End Sub
Private Sub Grid_SelChange()
Grid_Click
End Sub
Private Sub mnu_History_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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -