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

📄 frmsalesreturnae.frm

📁 Inventory control system
💻 FRM
📖 第 1 页 / 共 4 页
字号:
            End If
        End If
        
        'Save to stock card
        Dim RSStockCard As New Recordset
    
        RSStockCard.CursorLocation = adUseClient
        RSStockCard.Open "Stock_Card", CN, , adLockOptimistic, adCmdTable
        
        'Add record to stock card
        RSStockCard.AddNew
            
        RSStockCard!Type = "POR"
        RSStockCard!RefNo1 = ReceiptPK
        RSStockCard!Pieces1 = "-" & toNumber(txtQty.Text)
        RSStockCard!Cost = toNumber(txtPrice.Text)
        RSStockCard!StockID = intStockID
            
        RSStockCard.Update
            
        'Deduct qty returned to qty onhand in Stock_Unit tables
        Dim RSStockUnit As New Recordset
    
        RSStockUnit.CursorLocation = adUseClient
        RSStockUnit.Open "SELECT * From Stock_Unit", CN, adOpenStatic, adLockOptimistic
            
        'Deduct qty returned in stocks table
        RSStockUnit.Filter = "StockID = " & intStockID & " AND UnitID = " & dcUnit.BoundText
        
        RSStockUnit!Onhand = RSStockUnit!Onhand - toNumber(txtQty.Text)
        
        RSStockUnit.Update
                    
        'Add the amount to current load amount
        cIGross = cIGross + toNumber(txtGross(1).Text)
        txtGross(2).Text = Format$(cIGross, "#,##0.00")
        
        cDAmount = cDAmount + toNumber(toNumber(txtDisc.Text) / 100) * (toNumber(toNumber(txtQty.Text) * toNumber(txtPrice.Text)))
        
        cIAmount = cIAmount + toNumber(txtNetAmount.Text)
        
        txtDesc.Text = Format$(cDAmount, "#,##0.00")
        txtNet.Text = Format$(cIAmount, "#,##0.00")
        
        'Highlight the current row's column
        .ColSel = 9
        'Display a remove button
        Grid_Click
        'Reset the entry fields
        ResetEntry
    End With
End Sub

Private Sub btnRemove_Click()
    'Remove selected load product
    With Grid
        'Update grooss to current purchase amount
        cIGross = cIGross - toNumber(Grid.TextMatrix(.RowSel, 6))
        txtGross(2).Text = Format$(cIGross, "#,##0.00")
        'Update amount to current invoice amount
        cIAmount = cIAmount - toNumber(Grid.TextMatrix(.RowSel, 8))
        txtNet.Text = Format$(cIAmount, "#,##0.00")
        'Update discount to current invoice disc
        cDAmount = cDAmount - toNumber(toNumber(txtDisc.Text) / 100) * (toNumber(toNumber(Grid.TextMatrix(.RowSel, 4)) * toNumber(Grid.TextMatrix(.RowSel, 6))))
        txtDesc.Text = Format$(cDAmount, "#,##0.00")

        'Update the record count
        cIRowCount = cIRowCount - 1
        
        If .Rows = 2 Then Grid.Rows = Grid.Rows + 1
        .RemoveItem (.RowSel)
    End With

    btnRemove.Visible = False
    Grid_Click
    
End Sub

Private Sub dcUnit_Change()
    If dcUnit.Text = "" Or nsdStock.Tag = "" Then Exit Sub
    
    txtPrice.Text = toMoney(getValueAt("SELECT SalesPrice FROM qry_Stock_Unit WHERE StockID= " & nsdStock.Tag & " AND UnitID = " & dcUnit.BoundText & "", "SalesPrice"))
End Sub

Private Sub nsdClient_Change()
    txtCity.Text = nsdClient.getSelValueAt(3)
End Sub

Private Sub nsdStock_Change()
    On Error Resume Next
    
    nsdStock.Tag = nsdStock.BoundText
    txtQty.Text = "0"
    
    dcUnit.Text = ""
    bind_dc "SELECT * FROM qry_Unit WHERE StockID=" & nsdStock.BoundText & " ORDER BY qry_Unit.Order ASC", "Unit", dcUnit, "UnitID", True
    
'    txtPrice.Text = toMoney(nsdStock.getSelValueAt(3)) 'Supplier Price
End Sub

Private Sub txtdisc_Change()
    txtQty_Change
End Sub

Private Sub txtdisc_Click()
    txtQty_Change
End Sub

Private Sub cmdCancel_Click()
On Error Resume Next

    If blnSave = False Then CN.RollbackTrans
    
    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 cmdSave_Click()
    'Verify the entries
    If txtReturnSlipNo.Text = "" Then
        MsgBox "Please don't leave Return Slip No field blank.", vbInformation
        txtReturnSlipNo.SetFocus
        Exit Sub
    End If
    
    If cIRowCount < 1 Then
        MsgBox "Please enter item to return before saving this record.", vbExclamation
        Exit Sub
    End If
   
    If MsgBox("This save the record. Do you want to proceed?", vbQuestion + vbYesNo) = vbNo Then Exit Sub

    'Connection for Local_Purchase_Return
    Dim RSReturn As New Recordset

    RSReturn.CursorLocation = adUseClient
    RSReturn.Open "Sales_Return", CN, adOpenDynamic, adLockOptimistic, adCmdTable

    'Connection for Purchase_Order_Return_Detail
    Dim RSDetails As New Recordset

    RSDetails.CursorLocation = adUseClient
    RSDetails.Open "Sales_Return_Detail WHERE SalesReturnID=" & PK, CN, adOpenDynamic, adLockOptimistic, adCmdTable

    Screen.MousePointer = vbHourglass

    Dim c As Integer
    
    DeleteItems
    
    On Error GoTo err

    'Save the record
    With RSReturn
        If State = adStateAddMode Or State = adStatePopupMode Then
            .AddNew
            ![SalesReturnID] = PK
            ![ClientID] = nsdClient.Tag
            ![ReceiptID] = ReceiptPK
            
            ![DateAdded] = Now
            ![AddedByFK] = CurrUser.USER_PK
        ElseIf State = adStateEditMode Then
            .Close
            .Open "SELECT * FROM Sales_Return WHERE SalesReturnID=" & PK, CN, adOpenStatic, adLockOptimistic
            
            ![DateModified] = Now
            ![LastUserFK] = CurrUser.USER_PK
        End If

        ![ReturnSlipNo] = txtReturnSlipNo.Text
        ![Date] = dtpDate.Value
        ![Status] = IIf(cboStatus.Text = "Returned", True, False)
        ![Notes] = txtNotes.Text
        
        ![Gross] = toNumber(txtGross(2).Text)
        ![Discount] = txtDesc.Text
        ![NetAmount] = toNumber(txtNet.Text)
                
        .Update
    End With
   
    With Grid
        'Save the details of the records
        For c = 1 To cIRowCount
            .Row = c
            If State = adStateAddMode Or State = adStatePopupMode Then
AddNew:
                'Add qty received in Local Purchase Details
                RSDetails.AddNew
            
                RSDetails![SalesReturnID] = PK
                RSDetails![StockID] = toNumber(.TextMatrix(c, 10))
                RSDetails![Qty] = toNumber(.TextMatrix(c, 3))
                RSDetails![Unit] = getUnitID(.TextMatrix(c, 4))
                RSDetails![Price] = toNumber(.TextMatrix(c, 5))
                RSDetails![Discount] = toNumber(.TextMatrix(c, 7)) / 100
                RSDetails![ReturnType] = .TextMatrix(c, 9)
    
                RSDetails.Update
            ElseIf State = adStateEditMode Then
                RSDetails.Filter = "StockID = " & toNumber(.TextMatrix(c, 10))
            
                If RSDetails.RecordCount = 0 Then GoTo AddNew
            
                RSDetails![StockID] = toNumber(.TextMatrix(c, 10))
                RSDetails![Qty] = toNumber(.TextMatrix(c, 3))
                RSDetails![Unit] = getUnitID(.TextMatrix(c, 4))
                RSDetails![Price] = toNumber(.TextMatrix(c, 5))
                RSDetails![Discount] = toNumber(.TextMatrix(c, 7)) / 100
                RSDetails![ReturnType] = .TextMatrix(c, 9)
    
                RSDetails.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
'    CN.RollbackTrans
'    CN.BeginTrans
    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
'        txtInvoiceNo.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

    CN.BeginTrans
    
    Screen.MousePointer = vbHourglass
    
    'Check the form state
    If State = adStateAddMode Or State = adStatePopupMode Then
        InitNSD
        'Set the recordset
        rs.Open "SELECT * FROM qry_Receipts WHERE ReceiptID=" & ReceiptPK, CN, adOpenStatic, adLockOptimistic

        dtpDate.Value = Date
        Caption = "Create New Entry"
        cmdUsrHistory.Enabled = False
        
        GeneratePK
        DisplayForAdding
    Else
        'Set the recordset
        rs.Open "SELECT * FROM qry_Sales_Return WHERE SalesReturnID=" & PK, CN, adOpenStatic, adLockOptimistic
        
        If State = adStateViewMode Then
            cmdCancel.Caption = "Close"
                   
            DisplayForViewing
        Else
            InitNSD
            DisplayForEditing
        End If
        
    End If
    
    Screen.MousePointer = vbDefault
End Sub

'Procedure used to generate PK
Private Sub GeneratePK()
    PK = getIndex("Sales_Return")
End Sub

Private Sub ResetEntry()
    'nsdStock.ResetValue
    txtPrice.Tag = 0
    txtPrice.Text = "0.00"
    txtQty.Text = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
'    If HaveAction = True Then
'        frmSalesReturn.RefreshRecords
'    End If
    
    Set frmSalesReturnAE = Nothing
End Sub

Private Sub Grid_Click()
    With Grid
        If State = adStateViewMode Then Exit Sub
        
        dcUnit.Text = ""
        On Error Resume Next
        bind_dc "SELECT * FROM qry_Unit WHERE StockID=" & .TextMatrix(.RowSel, 10), "Unit", dcUnit, "UnitID", True
        On Error GoTo 0
        
        nsdStock.Text = .TextMatrix(.RowSel, 2)
        nsdStock.Tag = .TextMatrix(.RowSel, 10) 'Add tag coz boundtext is empty
        txtQty = .TextMatrix(.RowSel, 3)
        
        
        dcUnit.Text = .TextMatrix(.RowSel, 4)
        txtPrice = toMoney(.TextMatrix(.RowSel, 5))
        txtGross(1) = toMoney(.TextMatrix(.RowSel, 6))
        txtDisc = toMoney(.TextMatrix(.RowSel, 7))
        txtNetAmount = toMoney(.TextMatrix(.RowSel, 8))
        
        If Grid.Rows = 2 And Grid.TextMatrix(1, 10) = "" 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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -