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

📄 frmorder.frm

📁 一个OA办公自动化管理系统
💻 FRM
📖 第 1 页 / 共 4 页
字号:
On Error GoTo Err_SKP
    
    Dim i As Integer
    
    If KeyAscii = 13 Then
        If Me.GridSize.Col <> Me.GridSize.Columns.Count - 1 Then
            SendKeys "{TAB}"
        Else
            Me.TDBGrid1.SetFocus
            Me.TDBGrid1.Col = 0
            'SendKeys "{DOWN}"
            
        End If
    End If
    
    Exit Sub
Err_SKP:
    mis_HandError Err.Number, "tdbSize_KeyPress"
    Exit Sub


End Sub

Private Sub TDBGrid1_AfterUpdate()
    
    SumTotal
End Sub

Private Sub TDBGrid1_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
Dim rstlock As Recordset
   Dim i As Integer, LastCol As Integer
   
   
   If LastCol = -1 Then Exit Sub
    
   On Error GoTo Err_TDBGrid1_BeforeColUpdate
  
   If Me.TDBGrid1.Columns(ColIndex).DataField = "PlanQty" Or Me.TDBGrid1.Columns(ColIndex).DataField = "Qty" Then
        If Me.TDBGrid1.Columns("PlanQty").Visible = True Then
            Me.TDBGrid1.Columns("TotalQty").Value = Nz(TDBGrid1.Columns("PlanQty").Value, 0) - Nz(TDBGrid1.Columns("Qty").Value, 0)
        Else
            Me.TDBGrid1.Columns("TotalQty").Value = Nz(TDBGrid1.Columns("Qty").Value, 0)

        End If
    End If

      
    If Me.TDBGrid1.Columns(ColIndex).DataField = "Price" Or Me.TDBGrid1.Columns(ColIndex).DataField = "Qty" Then '
        Me.TDBGrid1.Columns("Amount").Value = Nz(TDBGrid1.Columns("Price").Value, 0) * Nz(TDBGrid1.Columns("Qty").Value, 0)
    End If
    
    If isLockStock = True Then
        Set rstlock = New Recordset
        rstlock.Open "Select * From v_FreeStock Where Inventory_ID ='" & Me.TDBGrid1.Columns("Inventory_ID").Value & "' and ContactNum ='" & DLookUp("ContactNum", "Mis_Stock", "Stock_ID='" & Me.CombDesStock_ID.Text & "'") & "'", GetCNClient, adOpenForwardOnly
        If rstlock.EOF Then
            MisMsg "仓库中没有该产品!"
            Cancel = 1
        Else
            Me.TDBGrid1.Columns("PlanQty").Text = Nz(rstlock![Qty])
            Cancel = 0
        End If
        Set rstlock = Nothing
        
    End If
    Exit Sub
Err_TDBGrid1_BeforeColUpdate:
    Exit Sub
End Sub

Private Sub TDBGrid1_BeforeDelete(Cancel As Integer)
    Cancel = 0
    IsChange = True
End Sub

Private Sub TDBGrid1_BeforeUpdate(Cancel As Integer)
'Stop
    If checkData(Me.TDBGrid1, Me.GridSize) = 0 Then
        Cancel = 1
        Exit Sub
    End If
    
    If isLockStock = True Then
        If CheckStock(Me.TDBGrid1, Me.GridSize, Me.CombDesStock_ID.Text) = 0 Then
            Cancel = 1
            Exit Sub
        End If
    End If
    If isLockupBill = True Then
        If CheckupBill(Me.TDBGrid1, Me.GridSize, Me.CombAbove_ID.Text) = 0 Then
            Cancel = 1
            Exit Sub
        End If
    End If


End Sub


Private Sub TDBGrid1_ButtonClick(ByVal ColIndex As Integer)
Dim strInv As String, intCol As Integer, i As Integer, s As String
On Error GoTo Err_lll
    If UCase(Me.TDBGrid1.Columns(ColIndex).DataField) = UCase("Inventory_ID") Then
        strInv = GetInvInfo
        If Trim(strInv) = "" Then Exit Sub
        Me.TDBGrid1.Columns("Inventory_ID").Value = strMid(strInv, 1)
        Me.TDBGrid1.Columns("Description").Value = strMid(strInv, 2)
        Me.TDBGrid1.Columns("Unit").Value = strMid(strInv, 3)
        Me.TDBGrid1.Columns("Price").Value = Val(strMid(strInv, 4))
        
        intCol = Me.TDBGrid1.Columns("Qty").ColIndex
        Me.TDBGrid1.Columns("Qty").Text = 0
        
        s = Me.TDBGrid1.Text
        SendKeys "0"
        Me.TDBGrid1.Text = s
            
        If Me.GridSize.Visible = True Then
            For i = 0 To Me.GridSize.Columns.Count - 1
               Me.GridSize.Columns(i).Value = 0
            Next
        End If
        
        isSize = Val(strMid(strInv, 6))
        SizeLoad clsBill.Recordset, isSize, Me.GridSize
        
        Me.TDBGrid1.SetFocus
        Me.TDBGrid1.Col = intCol
   '    Me.TDBGrid1.Columns("Qty").Text = 0
    
    End If
    Exit Sub
Err_lll:

End Sub

Private Sub TDBGrid1_ColResize(ByVal ColIndex As Integer, Cancel As Integer)
On Error GoTo TCR_Err
    SaveDataGridWidth "FrmGeneralBill", Me.TDBGrid1.Columns(ColIndex).DataField, Me.TDBGrid1.Columns(ColIndex).Width
    Exit Sub
TCR_Err:
    mis_HandError (Err.Number)
    Exit Sub
End Sub




Private Sub TDBGrid1_GotFocus()
    'MsgBox DLookUpLocal("Size_Type", "Inventory", "Inventory_ID='" & Me.TDBGrid1.Columns("Inventory_Id").Value & "'")
    SizeLoad clsBill.Recordset, DLookUpLocal("Size_Type", "Inventory", "Inventory_ID='" & Me.TDBGrid1.Columns("Inventory_Id").Value & "'"), Me.GridSize
    'Me.TDBGrid1.Col = LastCol
On Error GoTo Err_ddd
    
    Me.TDBGrid1.SetFocus
    Me.TDBGrid1.Col = 0
    Exit Sub
Err_ddd:

End Sub

Private Sub TDBGrid1_KeyPress(KeyAscii As Integer)
    'MsgBox Me.TDBGrid1.Columns(Me.TDBGrid1.Col).DataField
    If KeyAscii = 32 Then
        If Me.TDBGrid1.Columns(Me.TDBGrid1.Col).DataField = "Inventory_ID" Then
            TDBGrid1_ButtonClick Me.TDBGrid1.Col
            KeyAscii = 0
        End If
    End If
    If KeyAscii = 13 Then
        If Me.TDBGrid1.Columns(Me.TDBGrid1.Col).DataField = "Dis_type" Then
            If DLookUpLocal("Size_Type", "Inventory", "Inventory_ID='" & Me.TDBGrid1.Columns("Inventory_Id").Value & "'") <> 0 Then
                Me.GridSize.SetFocus
                Me.GridSize.Col = 0
            End If
        Else
            'Me.TDBGrid1.Col = 0
        End If
    End If
    If KeyAscii = 27 Then
        If Me.TDBGrid1.EditActive Then
        Else
            Me.TDBGrid1.DataChanged = False
        End If
    End If
End Sub


Private Sub TDBGrid1_OnAddNew()
    IsChange = True
    Me.TDBGrid1.Columns("Unit").Value = "双"
    Me.TDBGrid1.Columns("CurrencyType").Value = 1
    Me.TDBGrid1.Columns("Price").Value = 0
    Me.TDBGrid1.Columns("Employee").Value = LoginName
    Me.TDBGrid1.Columns("TaxRate").Value = 0
    Me.TDBGrid1.Columns("Dis_type").Value = "xz0"
    Me.TDBGrid1.Columns("ReasonID").Value = ""
    Me.TDBGrid1.Columns("PlanQty").Value = 0
    Me.TDBGrid1.Columns("Qty").Value = 0
    Me.TDBGrid1.Columns("TotalQty").Value = 0
    Me.TDBGrid1.Columns("Amount").Value = 0
    Me.TDBGrid1.Columns("Amount_tax").Value = 0
    Me.TDBGrid1.Columns("Amount_without_tax").Value = 0
    Me.TDBGrid1.Columns("TaxRate").Value = 0
    Me.TDBGrid1.Columns("Dis_Amount").Value = 0
    Me.TDBGrid1.Columns("ExchangeRate").Value = 0
    'Me.GridSize.ReBind
    
End Sub





Public Sub SumTotal()
'On Error Resume Next
Dim rstClone As adodb.Recordset
Dim PlanQty As Double, Qty As Double, TotalQty As Double, Amount As Double, Amount_tax As Double, Amount_without_tax As Double, Dis_Amount As Double

Set rstClone = New Recordset
Set rstClone = clsBill.Recordset
With rstClone
     If .RecordCount > 0 Then

        .MoveFirst
        Do Until .EOF
            PlanQty = PlanQty + ![PlanQty]
            Qty = Qty + ![Qty]
            TotalQty = TotalQty + ![TotalQty]
            Amount = Amount + ![Amount]
            Amount_tax = Amount_tax + ![Amount_tax]
            Amount_without_tax = Amount_without_tax + ![Amount_without_tax]
            Dis_Amount = Dis_Amount + ![Dis_Amount]
            
           .MoveNext
        Loop
        Me.TDBGrid1.Columns("PlanQty").FooterText = Format(PlanQty, "#,##0.00")
        Me.TDBGrid1.Columns("Qty").FooterText = Format(Qty, "#,##0.00")
        Me.TDBGrid1.Columns("TotalQty").FooterText = Format(TotalQty, "#,##0.00")
        Me.TDBGrid1.Columns("Amount").FooterText = Format(Amount, "#,##0.00")
        Me.TDBGrid1.Columns("Amount_tax").FooterText = Format(Amount_tax, "#,##0.00")
        Me.TDBGrid1.Columns("Amount_without_tax").FooterText = Format(Amount_without_tax, "#,##0.00")
        Me.TDBGrid1.Columns("Dis_Amount").FooterText = Format(Dis_Amount, "#,##0.00")

        
     End If
End With
Set rstClone = Nothing
End Sub

Public Function SizeSum(rstBill As Recordset) As Double
'On Error GoTo Err_CheckSize
'    Dim rstClone As Recordset
'    Set rstClone = New Recordset
'    Set rstClone = clsBill.Recordset

    Dim i As Integer
    If clsBill.Recordset.RecordCount = 0 Then Exit Function
    If clsBill.Recordset.EOF Then clsBill.Recordset.MoveLast
    'clsBill.Recordset.MoveLast
    For i = 1 To 30
       SizeSum = SizeSum + clsBill.Recordset.Fields("Q" & Format(i, "00")).Value
       
    Next
'Dim i As Integer
'    SizeSum = 0
'    For i = 0 To Me.GridSize.Columns.Count - 1
'        SizeSum = SizeSum + IIf(Me.GridSize.Columns(i).Text = "", 0, Me.GridSize.Columns(i).Value)
'    Next
    Exit Function

Err_CheckSize:
    MisMsg "CheckSize Error:" & Err.Description
    Exit Function
End Function

Private Sub iniDetail(BillName As String)
    Set Me.TDBGrid1.DataSource = clsBill.Recordset
    IniGeneralBill Me.TDBGrid1, BillName, True
    SizeLoad clsBill.Recordset, 0, Me.GridSize
    iniDis "Dis_Type"
    SumTotal
    Me.TDBGrid1.Columns("Description").Locked = True
    Me.TDBGrid1.Columns("Unit").Locked = True
    Me.TDBGrid1.Columns("Style").Locked = True
    Me.TDBGrid1.Columns("Amount").Locked = True
    Me.TDBGrid1.Columns("TotalQty").Locked = True
    Me.TDBGrid1.Columns("Amount_tax").Locked = True
    Me.TDBGrid1.Columns("Amount_without_tax").Locked = True
    Me.TDBGrid1.Columns("Dis_Amount").Locked = True

End Sub

Private Sub iniHead()
    Me.txtDate.Text = Format(Date, "yyyy-mm-dd")
    Dim rstTemp As Recordset
    Set rstTemp = New Recordset
    rstTemp.Open "Select ContactName From mis_Customer Where Type=1", GetCNClient, adOpenForwardOnly
    Me.CombContactName.Clear
    With rstTemp
        Do Until .EOF
            Me.CombContactName.AddItem ![ContactName]
            .MoveNext
        Loop
    End With
    Set rstTemp = Nothing

    Me.DTPDelivery_Date.Value = Date
End Sub
    
 
Public Function iniCmbData(str As String, field As Variant, StrWhere As String) As adodb.Recordset
  
    Dim rstTemp As Recordset
    Set rstTemp = New Recordset
    rstTemp.Open "Select " & field & " From " & str & " Where " & StrWhere & " ", GetCNClient, adOpenForwardOnly
    
    Set iniCmbData = rstTemp
    
End Function
Private Sub IniCmb()

'cmbStock_ID
  Dim rstTemp As New adodb.Recordset
  Set rstTemp.DataSource = iniCmbData("mis_stock", "description", "attribute=1")
  Me.CombStock_ID.Clear
    With rstTemp
        Do Until .EOF
            Me.CombStock_ID.AddItem ![Description]
            .MoveNext
        Loop
    End With
    Set rstTemp = Nothing

 'cmbDesStock
  Set rstTemp.DataSource = iniCmbData("mis_stock", "description", "attribute=1")
  Me.CombDesStock_ID.Clear
    With rstTemp
        Do Until .EOF
            Me.CombDesStock_ID.AddItem ![Description]
            .MoveNext
        Loop
    End With
    Set rstTemp = Nothing

'Exchange_good_mode
  Set rstTemp.DataSource = iniCmbData("Mis_ConsignMentMode", "description", "1=1")
  Me.CombType.Clear
    With rstTemp
        Do Until .EOF
            Me.CombType.AddItem ![Description]
            .MoveNext
        Loop
    End With
    Set rstTemp = Nothing

'contact
  Set rstTemp.DataSource = iniCmbData("mis_contact", "contactName", "1=1")
  Me.combEmployee.Clear
    With rstTemp
        Do Until .EOF
            Me.combEmployee.AddItem ![ContactName]
            .MoveNext
        Loop
    End With
    Set rstTemp = Nothing


End Sub

⌨️ 快捷键说明

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