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

📄 frmforwardersguideae.frm

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