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

📄 frmloadingae.frm

📁 Inventory control system
💻 FRM
📖 第 1 页 / 共 4 页
字号:
Private Sub btnLoad_Click()
   
    Dim CurrRow As Integer
    
    CurrRow = getFlexPos(Grid, 11, dcProd.BoundText)
    
    'Add to grid
    With Grid
        If CurrRow < 0 Then
            'Perform if the record is not exist
            If .Rows = 2 And .TextMatrix(1, 11) = "" Then
                .TextMatrix(1, 1) = dcProd.Text
                .TextMatrix(1, 2) = txtEntry(1).Text
                .TextMatrix(1, 3) = txtUC.Text
                .TextMatrix(1, 4) = txtEntry(2).Text
                .TextMatrix(1, 5) = txtEntry(3).Text
                .TextMatrix(1, 6) = txtEntry(4).Text
                .TextMatrix(1, 7) = txtLQty.Text
                .TextMatrix(1, 8) = txtVIQty.Text
                .TextMatrix(1, 9) = txtQty.Text
                .TextMatrix(1, 10) = txtAmount.Text
                .TextMatrix(1, 11) = dcProd.BoundText
                
            Else
                .Rows = .Rows + 1
                .TextMatrix(.Rows - 1, 1) = dcProd.Text
                .TextMatrix(.Rows - 1, 2) = txtEntry(1).Text
                .TextMatrix(.Rows - 1, 3) = txtUC.Text
                .TextMatrix(.Rows - 1, 4) = txtEntry(2).Text
                .TextMatrix(.Rows - 1, 5) = txtEntry(3).Text
                .TextMatrix(.Rows - 1, 6) = txtEntry(4).Text
                .TextMatrix(.Rows - 1, 7) = txtLQty.Text
                .TextMatrix(.Rows - 1, 8) = txtVIQty.Text
                .TextMatrix(.Rows - 1, 9) = txtQty.Text
                .TextMatrix(.Rows - 1, 10) = txtAmount.Text
                .TextMatrix(.Rows - 1, 11) = dcProd.BoundText
                
                .Row = .Rows - 1
            End If
            'Increase the record count
            clRowCount = clRowCount + 1
        Else
            'Perform if the record already exist
            If MsgBox("Product already loaded.Do you want to replace it?", vbQuestion + vbYesNo) = vbYes Then
                .Row = CurrRow
                
                'Restore back the collected amount
                clAmount = clAmount - toNumber(Grid.TextMatrix(.RowSel, 10))
                txtCLAmount.Text = toMoney(clAmount)
            
                .TextMatrix(CurrRow, 1) = dcProd.Text
                .TextMatrix(CurrRow, 2) = txtEntry(1).Text
                .TextMatrix(CurrRow, 3) = txtUC.Text
                .TextMatrix(CurrRow, 4) = txtEntry(2).Text
                .TextMatrix(CurrRow, 5) = txtEntry(3).Text
                .TextMatrix(CurrRow, 6) = txtEntry(4).Text
                .TextMatrix(CurrRow, 7) = txtLQty.Text
                .TextMatrix(CurrRow, 8) = txtVIQty.Text
                .TextMatrix(CurrRow, 9) = txtQty.Text
                .TextMatrix(CurrRow, 10) = txtAmount.Text
                .TextMatrix(CurrRow, 11) = dcProd.BoundText
            Else
                Exit Sub
            End If

            
        End If
        'Add the amount to current load amount
        clAmount = clAmount + toNumber(txtAmount.Text)
        txtCLAmount.Text = Format$(clAmount, "#,##0.00")
        'Highlight the current row's column
        .ColSel = 11
        'Display a remove button
        Grid_Click
        'Reset the entry fields
        ResetEntry
    End With
End Sub

Private Sub btnPick_Click()
    If MsgBox("This will get and display the quantity of the selected product from van inventory." & vbCrLf & "Do you want to continue?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
    
    If LLFK = 0 Then
        MsgBox "You did not select your last loading date.In order to get the qty of your van inventory close this form and try to add new record again and then select your last loading date from a drop-down list.", vbExclamation
    Else
        Dim tRS As New Recordset
        
        tRS.Open "SELECT * FROM qry_IC_VanInvDetails WHERE LLFK=" & LLFK, CN, adOpenStatic, adLockReadOnly
        
        If tRS.RecordCount > 0 Then
            txtEntry(5).Text = toNumber(tRS![SoldCases])
            txtEntry(6).Text = toNumber(tRS![SoldBoxes])
            txtEntry(7).Text = toNumber(tRS![SoldPieces])
            MsgBox "The quantity of the product from your van inventory has been loaded.", vbInformation
        Else
            MsgBox "Unable to find the selected product from your van inventory.", vbExclamation
            dcProd.SetFocus
        End If
        
        tRS.Close
        Set tRS = Nothing
    End If
End Sub

Private Sub btnProdAvailable_Click()
    'Display Product Stock Info
    frmStockViewer.show vbModal
End Sub

Private Sub btnRemove_Click()
    'Remove selected load product
    With Grid
        'Update amount to current load amount
        clAmount = clAmount - toNumber(Grid.TextMatrix(.RowSel, 10))
        txtCLAmount.Text = Format$(clAmount, "#,##0.00")
        'Update the record count
        clRowCount = clRowCount - 1
        
        If .Rows = 2 Then Grid.Rows = Grid.Rows + 1
        .RemoveItem (.RowSel)
    End With

    btnRemove.Visible = False
    Grid_Click
    
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdSave_Click()
    'Verify the entries
    If dcVan.BoundText = "" Then
        MsgBox "Please select a van in the list.", vbExclamation
        dcVan.SetFocus
        Exit Sub
    End If
    If clRowCount < 1 Then
        MsgBox "Please load a product first before you can save this record.", vbExclamation
        dcProd.SetFocus
        Exit Sub
    End If
    
    If MsgBox("This save the record.Do you want to proceed?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
    
    Screen.MousePointer = vbHourglass
    
    Dim RSDetails As New Recordset
    Dim EntryIsOK As Boolean
    Dim ProdPK As Long 'Product Primary Key
    Dim tC As Long 'Temporary Case - Based on actual product quantity
    Dim tB As Long 'Temporary Box --^
    Dim tP As Long 'Temporary Pieces --^
    
    EntryIsOK = True
    
    RSDetails.CursorLocation = adUseClient
    RSDetails.Open "SELECT * FROM tbl_IC_LoadingDetails WHERE LoadingFK=" & PK, CN, adOpenStatic, adLockOptimistic
    
    Dim c As Integer
    
    On Error GoTo err
    
    CN.BeginTrans
    
    'Save the record
    With rs
        If State = adStateAddMode Or State = adStatePopupMode Then
            .AddNew
            ![PK] = PK
            ![DateAdded] = Now
            ![AddedByFK] = CurrUser.USER_PK
        Else
            ![DateModified] = Now
            ![LastUserFK] = CurrUser.USER_PK
        End If
        ![LoadingNo] = txtEntry(0).Text
        ![Date] = dtpDate.Value
        ![VanFK] = dcVan.BoundText
        
        .Update
    End With
    
    With Grid
        'Save the details of the records
        For c = 1 To clRowCount
            .Row = c
            If State = adStateAddMode Or State = adStatePopupMode Then
            
                ProdPK = toNumber(.TextMatrix(c, 11))
                
                tC = toNumber(getValueAt("SELECT PK,Cases FROM tbl_IC_Products WHERE PK=" & ProdPK, "Cases"))
                tB = toNumber(getValueAt("SELECT PK,Boxes FROM tbl_IC_Products WHERE PK=" & ProdPK, "Boxes"))
                tP = toNumber(getValueAt("SELECT PK,Pieces FROM tbl_IC_Products WHERE PK=" & ProdPK, "Pieces"))
                
                If toNumber(.TextMatrix(c, 4)) > tC Then EntryIsOK = False: .Col = 4: .CellForeColor = &HFF&: .CellFontBold = True
                If toNumber(.TextMatrix(c, 5)) > tB Then EntryIsOK = False: .Col = 5: .CellForeColor = &HFF&: .CellFontBold = True
                If toNumber(.TextMatrix(c, 6)) > tP Then EntryIsOK = False: .Col = 6: .CellForeColor = &HFF&: .CellFontBold = True
                
                RSDetails.AddNew
                
                RSDetails![PK] = getIndex("tbl_IC_LoadingDetails")
                
                RSDetails![LoadingFK] = PK
                RSDetails![ProductFK] = ProdPK
                RSDetails![UnitCost(Each)] = toNumber(.TextMatrix(c, 3))
                RSDetails![Cases] = toNumber(.TextMatrix(c, 4))
                RSDetails![Boxes] = toNumber(.TextMatrix(c, 5))
                RSDetails![Pieces] = toNumber(.TextMatrix(c, 6))
                RSDetails![QtyLoad] = toNumber(.TextMatrix(c, 7))
                RSDetails![VanInv] = toNumber(.TextMatrix(c, 8))
                
                RSDetails.Update
                
                'Update stock value
                ChangeValue CN, "tbl_IC_Products", "Cases", tC - toNumber(.TextMatrix(c, 4)), True, "WHERE PK=" & ProdPK
                ChangeValue CN, "tbl_IC_Products", "Boxes", tB - toNumber(.TextMatrix(c, 5)), True, "WHERE PK=" & ProdPK
                ChangeValue CN, "tbl_IC_Products", "Pieces", tP - toNumber(.TextMatrix(c, 6)), True, "WHERE PK=" & ProdPK

            End If

        Next c
    End With
    
    'Clear variables
    c = 0
    ProdPK = 0
    tC = 0
    tB = 0
    tP = 0
    Set RSDetails = Nothing
    
    If EntryIsOK = True Then
        CN.CommitTrans
    Else
        CN.RollbackTrans
        MsgBox "Some product/s have not enough quantity to serve for this loading." & vbCrLf & _
               "Please check the stock value of the loaded products with red color in the list.", vbExclamation
        Grid.Row = 1
        Grid.Col = 0
        'Grid.ColSel = 11
        Grid.SetFocus
        Screen.MousePointer = vbDefault
        Exit Sub
    End If
    
    HaveAction = True
    Screen.MousePointer = vbDefault

    If State = adStateAddMode Then
        MsgBox "New record has been successfully saved.", vbInformation
        If MsgBox("Do you want to add another new record?", vbQuestion + vbYesNo) = vbYes Then
            ResetFields
            GeneratePK
         Else
            Unload Me
        End If
    Else
        MsgBox "Changes in  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 dcProd_Click(Area As Integer)
    On Error Resume Next
    If Area = 2 Then
        If dcProd.BoundText <> "" Then
            ResetEntry
            DiplayProdInfo
        End If
    End If
End Sub

Private Sub Form_Activate()
On Error Resume Next
    If CloseMe = True Then Unload Me: Exit Sub
    txtEntry(0).SetFocus
End Sub

Private Sub Form_Load()
    dtpDate.Value = Date
    
    'Bind the data combo
    bind_dc "SELECT * FROM tbl_AR_Van", "VanName", dcVan, "PK", True
    
    InitGrid
    
    'Check the form state
    If State = adStateAddMode Or State = adStatePopupMode Then
        frmLoadingAEPickFrom.show vbModal
        
        'Set the recordset
        rs.Open "SELECT * FROM tbl_IC_Loading WHERE PK=" & PK, CN, adOpenStatic, adLockOptimistic
        'Bind the combo
        bind_dc "SELECT * FROM tbl_IC_Products", "ProductCode", dcProd, "PK", True
        Caption = "Create New Entry"
        cmdUsrHistory.Enabled = False
        GeneratePK
        DiplayProdInfo
    Else
        Screen.MousePointer = vbHourglass
        'Set the recordset
        rs.Open "SELECT * FROM qry_IC_Loading WHERE PK=" & PK, CN, adOpenStatic, adLockOptimistic

        Caption = "View Record"
        cmdCancel.Caption = "Close"
        cmdUsrHistory.Enabled = True
        btnProdAvailable.Enabled = False
        txtEntry(0).Width = txtDate.Width
        DisplayForViewing
        
        MsgBox "This is use for viewing the record only." & vbCrLf & _
               "You cannot perform any changes in this form." & vbCrLf & vbCrLf & _
               "Note:If you have mistake in adding this record then " & vbCrLf & _
               "void this record and re-enter.", vbExclamation
        
        Screen.MousePointer = vbDefault
    End If
    
End Sub

'Procedure used to generate PK
Private Sub GeneratePK()
    PK = getIndex("tbl_IC_Loading")
    txtEntry(0).Text = GenerateID(PK, Format$(Date, "yyyy") & Format$(Date, "mm") & Format$(Date, "dd") & "-", "0")
End Sub

'Procedure used to initialize the grid
Private Sub InitGrid()
    clRowCount = 0
    With Grid

⌨️ 快捷键说明

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