📄 frmforwardersguideae1.frm
字号:
Else
MsgBox "All items are already delivered to VT.", vbInformation
End If
End Sub
Private Sub dcClass_Click(Area As Integer)
txtAmount4.Enabled = True
cboClass.Enabled = True
cboClass.Clear
If dcClass.Text = "Loose Cargo" Then
cboClass.AddItem "Bundle by Cases"
cboClass.AddItem "Bundle by Bags"
cboClass.AddItem "Sacks"
txtFreight.Locked = True
Grid.TextMatrix(0, 10) = "Freight Amt."
Labels(7).Caption = "Freight Amt."
'dblLoose = dblLoose + GetFreight(nsdShippingCo.Text, dcClass.Text)
'txtAmount4.Text = toMoney(dblLoose)
Else
'If nsdShippingCo.Text = "" Then Exit Sub
'txtAmount4.Text = toMoney(GetFreight(nsdShippingCo.Text, dcClass.Text))
'txtFreight.Locked = False
End If
End Sub
Private Function GetFreight(ByVal Company As String, ByVal Class As String) As Double
' Dim sql As String
' Dim rstemp As New ADODB.Recordset
'
' sql = "SELECT Cargo_Class.Freight " _
' & "FROM Shipping_Company INNER JOIN Cargo_Class ON Shipping_Company.ShippingCompanyID = Cargo_Class.ShippingCompanyID " _
' & "WHERE (((Shipping_Company.ShippingCompany)='" & Replace(Company, "'", "''") & "') AND " _
' & "((Cargo_Class.Class)='" & Replace(Class, "'", "''") & "'))"
' rstemp.Open sql, CN, adOpenDynamic, adLockOptimistic
' If Not rstemp.EOF Then
' GetFreight = rstemp!freight
' Else
' GetFreight = 0
' End If
'
'
' rstemp.Close
' Set rstemp = Nothing
End Function
Private Sub nsdLocal_Change()
Dim sql As String
Dim rstemp As New ADODB.Recordset
sql = "SELECT Local_Forwarder.LocalForwarderID, Local_Forwarder_Account_Description.AccTitle, Local_Forwarder_Detail.Amount " _
& "FROM Local_Forwarder_Account_Description RIGHT JOIN (Local_Forwarder LEFT JOIN Local_Forwarder_Detail ON Local_Forwarder.LocalForwarderID = Local_Forwarder_Detail.LocalForwarderID) ON Local_Forwarder_Account_Description.LocalForwarderAccTitleID = Local_Forwarder_Detail.AccountDescriptionID " _
& "WHERE (((Local_Forwarder.LocalForwarder)='" & Replace(nsdLocal.Text, "'", "''") & "'))"
rstemp.Open sql, CN, adOpenDynamic, adLockOptimistic
txtAmount6.Text = "0.00"
txtAmount7.Text = "0.00"
Do While Not rstemp.EOF
If rstemp!AccTitle = "Local Trucking" Then txtAmount6.Text = toMoney(rstemp!Amount)
If rstemp!AccTitle = "Sidewalk Handling" Then txtAmount7.Text = toMoney(rstemp!Amount)
rstemp.MoveNext
Loop
rstemp.Close
Set rstemp = Nothing
End Sub
Private Sub txtAmount1_Change()
txtTotalTranspoCost.Text = toMoney(toNumber(txtAmount1.Text) + toNumber(txtAmount2.Text) _
+ toNumber(txtAmount3.Text) + toNumber(txtAmount4.Text) + toNumber(txtAmount5.Text) _
+ toNumber(txtAmount6.Text) + toNumber(txtAmount7.Text))
End Sub
Private Sub txtAmount2_Change()
txtAmount1_Change
End Sub
Private Sub txtAmount3_Change()
txtAmount1_Change
End Sub
Private Sub txtAmount4_Change()
'txtAmount1_Change
End Sub
Private Sub txtAmount5_Change()
txtAmount1_Change
End Sub
Private Sub txtAmount6_Change()
txtAmount1_Change
End Sub
Private Sub txtAmount7_Change()
txtAmount1_Change
End Sub
Private Sub txtCostPerPackage_Click()
' MsgBox Grid.Row
End Sub
Private Sub txtdisc_Change()
If Trim(txtDisc.Text) = "" Then txtDisc.Text = 0
txtRQty_Change
End Sub
Private Sub txtdisc_Click()
txtQty_Change
End Sub
Private Sub CmdCancel_Click()
Unload Me
End Sub
Private Sub txtDisc_GotFocus()
HLText txtDisc
End Sub
Private Sub txtdisc_Validate(Cancel As Boolean)
txtDisc.Text = toNumber(txtDisc.Text)
End Sub
Private Sub cmdPH_Click()
'frmInvoiceViewerPH.INV_PK = PK
'frmInvoiceViewerPH.Caption = "Payment History Viewer"
'frmInvoiceViewerPH.lblTitle.Caption = "Payment History Viewer"
'frmInvoiceViewerPH.show vbModal
End Sub
Private Sub cmdSave_Click()
'Verify the entries
If Trim(nsdShippingCo.Text) = "" Then
MsgBox "Please enter shipping company before saving.", vbExclamation
Exit Sub
End If
If (dcClass.Text = "A" Or dcClass.Text = "B" Or dcClass.Text = "C") And Trim(txtVanNo.Text) = "" Then
MsgBox "Please enter Van No. before saving.", vbExclamation
Exit Sub
End If
If cIRowCount < 1 Then
MsgBox "Please enter item to return before saving this record.", vbExclamation
Exit Sub
End If
'check if freight allocation is 100 percent
Dim i As Integer
Dim j As Double
j = 0
For i = 1 To Grid.Rows - 1
j = j + toNumber(Grid.TextMatrix(i, 10))
Next
If (Grid.Rows > 2) And (j <> 100) Then
MsgBox "System detects that your freight allocation has a problem, please make correction before saving.", vbExclamation
Exit Sub
End If
'----
If MsgBox("This save the record. Do you want to proceed?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
'Connection for Forwarders
Dim RSShipping As New Recordset
RSShipping.CursorLocation = adUseClient
RSShipping.Open "Forwarders", CN, adOpenDynamic, adLockOptimistic, adCmdTable
'Connection for Forwarders_Detail
Dim RSDetails As New Recordset
RSDetails.CursorLocation = adUseClient
RSDetails.Open "Forwarders_Detail", CN, adOpenDynamic, adLockOptimistic, adCmdTable
'Connection for Transportation_Cost
Dim RSTransport As New Recordset
RSTransport.CursorLocation = adUseClient
RSTransport.Open "Transportation_Cost", CN, adOpenDynamic, adLockOptimistic, adCmdTable
Screen.MousePointer = vbHourglass
Dim c As Integer
On Error GoTo err
CN.BeginTrans
'Save the record
With RSShipping
.AddNew
Dim ShippingPK As Integer
ShippingPK = getIndex("Forwarders")
![POID] = PK
![DRNo] = ShippingPK
![ForwarderID] = ShippingPK
![ShippingCompanyID] = nsdShippingCo.BoundText
![ShippingGuideNo] = txtShippingGuideNo.Text
![Ship] = txtShip.Text
![ArrivalDate] = dtpShippingDate.Value
![DRNo] = txtDRNo.Text
![BLNo] = txtBLNo.Text
![TruckNo] = txtTruckNo.Text
![VanNo] = txtVanNo.Text
![VoyageNo] = txtVoyageNo.Text
![Ambot1] = cboAmbot.Text
![ReceiptNo] = txtReceipt.Text
![ReceiptDate] = dtpReceiptDate.Value
![CheckNo] = txtCheckNo.Text
![SendThru] = cboSendThru.Text
![Total] = CDbl(txtTotal.Text)
![CostPerPackage] = toNumber(txtCostPerPackage.Text)
![Gross] = toNumber(txtGross(2).Text)
![Discount] = txtDesc.Text
![TaxBase] = toNumber(txtTaxBase.Text)
![Vat] = toNumber(txtVat.Text)
![NetAmount] = toNumber(txtNet.Text)
![LocalForwarderID] = nsdLocal.BoundText
![DateAdded] = Now
![AddedByFK] = CurrUser.USER_PK
.Update
End With
'Save the record
With RSTransport
.AddNew
![ForwarderID] = ShippingPK
!MlaTruckingDate = dtp1.Value: !MlaTruckingOR = txtOR1.Text: !MlaTruckingAmount = txtAmount1.Text
!MlaArrastreDate = dtp1.Value: !MlaArrastreOR = txtOR2.Text: !MlaArrastreAmount = txtAmount2.Text
!MlaWfgFeeDate = dtp1.Value: !MlaWfgFeeOR = txtOR3.Text: !MlaWfgFeeAmount = txtAmount3.Text
!FreightDate = dtp1.Value: !FreightOR = txtOR4.Text: !FreightAmount = txtAmount4.Text
!LocalArrastreDate = dtp1.Value: !LocalArrastreOR = txtOR5.Text: !LocalArrastreAmount = txtAmount5.Text
!LocalTruckingDate = dtp1.Value: !LocalTruckingOR = txtOR6.Text: !LocalTruckingAmount = txtAmount6.Text
!SidewalkHandlingDate = dtp1.Value: !SidewalkHandlingOR = txtOR7.Text: !SidewalkHandlingAmount = txtAmount7.Text
.Update
End With
With Grid
'Save to Shipping Guide Details
Dim RSSPurchaseOrderDetails As New Recordset
RSSPurchaseOrderDetails.CursorLocation = adUseClient
RSSPurchaseOrderDetails.Open "SELECT * From Purchase_Order_Detail where POID = " & PK, CN, , adLockOptimistic
'Save the details of the records
For c = 1 To cIRowCount
.Row = c
RSDetails.AddNew
RSDetails![ForwarderID] = ShippingPK
RSDetails![StockID] = toNumber(.TextMatrix(c, 11))
RSDetails![Qty] = toNumber(.TextMatrix(c, 3))
RSDetails![UnitID] = getUnitID(.TextMatrix(c, 4))
RSDetails![Value] = CDbl(.TextMatrix(c, 5))
RSDetails![Class] = .TextMatrix(c, 6)
RSDetails![FreightPercent] = toNumber(.TextMatrix(c, 10))
RSDetails.Update
'add qty received in Purchase Order Details
RSSPurchaseOrderDetails.Find "[StockID] = " & toNumber(.TextMatrix(c, 11)), , adSearchForward, 1
RSSPurchaseOrderDetails!QtyReceived = toNumber(RSSPurchaseOrderDetails!QtyReceived) + toNumber(.TextMatrix(c, 3))
RSSPurchaseOrderDetails.Update
Next c
End With
'Clear variables
c = 0
Set RSDetails = Nothing
CN.CommitTrans
HaveAction = True
Screen.MousePointer = vbDefault
If State = adStateAddMode Then
MsgBox "New 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 Form_Activate()
On Error Resume Next
If CloseMe = True Then
Unload Me
Else
nsdShippingCo.SetFocus
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys ("{tab}")
End Sub
Private Sub InitNSD()
'For Shipping Company
With nsdShippingCo
.ClearColumn
.AddColumn "ID", 500.89
.AddColumn "Shipping Company", 1794.89
.Connection = CN.ConnectionString
.sqlFields = "ShippingCompanyID, ShippingCompany"
.sqlTables = "qry_Shipping_Company"
.sqlSortOrder = "ShippingCompany ASC"
.BoundField = "ShippingCompanyID"
.PageBy = 25
.DisplayCol = 2
.setDropWindowSize 7000, 4000
.TextReadOnly = True
.SetDropDownTitle = "Shipping Companies"
End With
With nsdLocal
.ClearColumn
.AddColumn "ID", 500.89
.AddColumn "Local Forwarder", 1794.89
.Connection = CN.ConnectionString
.sqlFields = "LocalForwarderID, LocalForwarder"
.sqlTables = "Local_Forwarder"
.sqlSortOrder = "LocalForwarder ASC"
.BoundField = "LocalForwarderID"
.PageBy = 25
.DisplayCol = 2
.setDropWindowSize 7000, 4000
.TextReadOnly = True
.SetDropDownTitle = "Local Forwarder"
End With
End Sub
Private Function ShippingGuideNo() As Long
ShippingGuideNo = getIndex("Forwarders")
End F
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -