⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmforwardersguideae1.frm

📁 Inventory control system
💻 FRM
📖 第 1 页 / 共 5 页
字号:
  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 + -