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

📄 frmorder.frm

📁 一个OA办公自动化管理系统
💻 FRM
📖 第 1 页 / 共 4 页
字号:
    End If
    iniBillPower Me, Me.txtBillNO.Text, islocal

End Sub

Private Sub cmdRead_Click()
    IsChange = False
    isNew = True
    Dim Temp As String, strTemp As String
    strBillNo = ""
    strTemp = GetBillNo(BillType)
    Temp = strMid(strTemp, 1)
    islocal = Val(strMid(strTemp, 2))
    If Temp <> "" Then
        Me.txtBillNO.Text = Temp
    End If
    iniBillPower Me, Me.txtBillNO.Text, islocal

End Sub

Private Sub cmdRefer_Click()
    IsSave
    If Me.cmdRefer.Caption = "提交" Then
        isNew = False
        OldBillNo = Me.txtBillNO.Text
        Me.txtBillNO.Text = ServerBillNo(BillType)
        If isLockStock = True Then
            If CheckFreeStock(Me.txtBillNO.Text, Me.CombDesStock_ID.Text) <> 0 Then
                MisMsg "库存数量不足"
                Exit Sub
            End If
        End If
        If isLockupBill Then
            If CheckFreeupBill(Me.txtBillNO.Text, Me.CombAbove_ID.Text) <> 0 Then
                MisMsg Me.CombAbove_ID.Text & "数量不足!"
                Exit Sub
            End If
        End If
        If DataTransForward(Trim(Me.txtBillNO.Text), Me.name, 0, Me.CombAbove_ID.Text) Then
           MisMsg Trim(Me.txtBillNO.Text) & " 提交成功!"
        End If
        isNew = True
        islocal = 1
    Else
       If DataTransBackward(Trim(Me.txtBillNO.Text), Me.name, 0, Me.CombAbove_ID.Text) Then
          MisMsg Trim(Me.txtBillNO.Text) & "反提交成功!"
               islocal = 0

       End If
    
    End If
    iniBillPower Me, Me.txtBillNO.Text, islocal

End Sub


Public Function getCusName() As String
    Dim frmCusName As frmCustomer
        Set frmCusName = New frmCustomer
        frmCusName.cusType = "1"
        Set frmCusName.Parent = Me
        frmCusName.Show 1
        getCusName = ReturnCusName
End Function

Private Sub CombContactName_Change()
    Dim rstClient As Recordset
    Set rstClient = New Recordset
    rstClient.Open "Select * From mis_Customer Where ContactName='" & Me.CombContactName.Text & "'", GetCNClient, adOpenForwardOnly
    If Not rstClient.EOF Then
        Me.CombType.Text = DLookUp("Description", "Mis_ConsignMentMode", "id='" & rstClient![ConsignMentMode] & "'")
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
'    If KeyAscii = 13 Then
'         SendKeys "{TAB}"
'    End If
'
End Sub

Private Sub GridSize_AfterColUpdate(ByVal ColIndex As Integer)
    Me.TDBGrid1.Columns(1).Text = Me.TDBGrid1.Columns(1).Text
End Sub

Private Sub TDBGrid1_BeforeColEdit(ByVal ColIndex As Integer, ByVal KeyAscii As Integer, Cancel As Integer)
    IsChange = True
    

End Sub


Private Sub TDBGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
If intRow <> Me.TDBGrid1.Row Then
    'If IIf(IsNull(Me.TDBGrid1.Columns("Inventory_ID").Value), "", Me.TDBGrid1.Columns("Inventory_ID").Value) = "" Then Exit Sub
    SizeLoad clsBill.Recordset, DLookUpLocal("Size_Type", "Inventory", "Inventory_ID='" & Me.TDBGrid1.Columns("Inventory_Id").Value & "'"), Me.GridSize
    Me.TDBGrid1.SetFocus
    Me.TDBGrid1.Col = LastCol
   'MsgBox "00"
    intRow = Me.TDBGrid1.Row
End If

End Sub

Private Sub txtBillNo_Change()
Me.MousePointer = 11
'    If Trim(Me.txtBillNo.Text) = "" Then
'        MisMsg "没有单据号码!"
'        Me.MousePointer = 0
'        Exit Sub
'    End If
    If isNew Then
        If clsBill.GetData(Me.txtBillNO.Text, islocal) = 0 And ReadHead(Me.txtBillNO.Text) = 0 Then
        End If
    Else
        GetCNLocal.Execute "Update Local_Inventory_Evidence Set Evidence_Number='" & Me.txtBillNO.Text & "' where  Evidence_Number='" & OldBillNo & "'"
        GetCNLocal.Execute "Update Local_Inventory_Evidence_Detail Set Evidence_Number='" & Me.txtBillNO.Text & "' where  Evidence_Number='" & OldBillNo & "'"
        MisMsg "当前单据编号为:" & Me.txtBillNO.Text
        
    End If
    iniDetail BillName

Me.MousePointer = 0

End Sub

Private Sub txtBillNo_GotFocus()
IsSave

End Sub


Public Sub cmdSave_Click()

    Me.MousePointer = 11
    
    If Nz(Me.txtBillNO.Text, "") = "" Then
        MsgBox "单据编号不能为空!"
        Exit Sub
    End If


    If clsBill.SaveData(Me.txtBillNO.Text, 0) <> 0 And SaveHead(Me.txtBillNO.Text, BillType) <> 0 Then
        MisMsg Me.txtBillNO.Text & " 数据保存成功!"
        IsChange = False
    End If
    Me.MousePointer = 0
End Sub


Private Sub DataGrid1_BeforeDelete(Cancel As Integer)
    IsChange = True

End Sub




Private Sub DataGrid1_Error(ByVal DataError As Integer, Response As Integer)
'    Response = 0
End Sub


Private Sub Form_Load()
Dim rstData As Recordset
isSize = 0
intRow = 0
Set clsBill = New clsOrder
islocal = 0
BillType = 103
BillName = "v_Order"



isNew = True
IsChange = False

isLockStock = True
isLockupBill = False

iniHead
Me.txtBillNO.Text = NewBillNo(BillType)
iniDis "Dis_Type"
iniBillPower Me, Me.txtBillNO.Text, islocal



'Me.Height = 6720
'Me.Width = 10605
'Me.Top = 10
'Me.Left = 10


IniCmb

End Sub

Public Sub iniDis(colName As String, Optional DefaultValue As String = "")
    Dim ii As New ValueItem
    Dim rstPower As Recordset
    Set rstPower = New Recordset
    rstPower.Open "Select *  From Mis_Reason Where ReasonType=" & BillType & "", GetCNClient, adOpenForwardOnly
    
    Me.TDBGrid1.Columns(colName).ValueItems.Clear
    
    Do Until rstPower.EOF
       ii.Value = rstPower![ReasonID]
       ii.DisplayValue = rstPower![Description]
       Me.TDBGrid1.Columns(colName).ValueItems.Add ii
       rstPower.MoveNext
    Loop
    Me.TDBGrid1.Columns(colName).Value = DefaultValue
End Sub

Public Function ReadHead(BillNO As String) As Integer
ReadHead = 1
'On Error GoTo Err_ReadHead

Dim rstReadHead As Recordset
Set rstReadHead = New Recordset
If islocal = 0 Then
    rstReadHead.Open "SELECT Local_Inventory_Evidence.* FROM Local_Inventory_Evidence where Evidence_Number ='" & BillNO & "'", GetCNLocal, adOpenStatic, adLockReadOnly
Else
    rstReadHead.Open "SELECT Inventory_Evidence.* FROM Inventory_Evidence where Evidence_Number ='" & BillNO & "'", GetCNClient, adOpenStatic, adLockReadOnly

End If
With rstReadHead
    If .RecordCount > 0 Then
          Me.CombContactName.Text = DLookUp("ContactName", "mis_Customer", "ContactNum='" & ![OtherStock_ID] & "'") & ""
          Me.combEmployee.Text = DLookUp("contactName", "mis_contact", "contactid='" & ![Employee1] & "'")
          Me.txtDate.Text = Format(![Date], "yyyy-mm-dd")
          Me.DTPDelivery_Date.Value = Format(![Delivery_Date], "yyyy-mm-dd")
          Me.CombType.Text = DLookUp("description", "Mis_ConsignMentMode", "id='" & ![Delivery_Type] & "'")
          Me.txtAddr = ![Delivery_Address] & ""
          Me.TxtSummary.Text = ![Summary] & ""
          Me.CombAbove_ID.Text = ![Above_ID] & ""
          Me.CombStock_ID.Text = DLookUp("description", "mis_stock", "stock_id='" & ![Stock_ID] & "'")
          Me.CombDesStock_ID.Text = DLookUp("description", "mis_stock", "stock_id='" & ![DesStock_ID] & "'")
    
    Else
          Me.CombContactName.Text = ""
          Me.combEmployee.Text = ""
          Me.txtDate.Text = Format(Date, "yyyy-mm-dd")
          Me.DTPDelivery_Date.Value = Format(Date, "yyyy-mm-dd")
          Me.CombType.Text = ""
          Me.txtAddr = ""
          Me.TxtSummary.Text = ""
          Me.CombAbove_ID.Text = ""
          Me.CombStock_ID.Text = ""
          Me.CombDesStock_ID.Text = ""
    
    End If
End With
    ReadHead = 0
    Exit Function
Err_ReadHead:
    ReadHead = 1
    MisMsg "ReadHead Error:" & Err.Description
    Exit Function

End Function
Public Function SaveHead(BillNO As String, BillType As Integer) As Integer
SaveHead = 0
'On Error GoTo Err_SaveHead
'
If Trim(Me.CombContactName.Text) = "" Then
    MisMsg "客户名称必须填写!"
    Exit Function
End If

If Trim(txtBillNO.Text) = "" Then
    MisMsg "凭证号码必须填写!"
    Exit Function
End If

If Format(Me.DTPDelivery_Date.Value, "yyyy-mm-dd") <= Format(Me.txtDate.Text, "yyyy-mm-dd") Then
    MisMsg "交货时间不能小于或等于开单时间!"
    Exit Function
End If

If Trim(CombType.Text) = "" Then
    MisMsg "交货方式必须填写!"
    Exit Function
End If


Dim rstSaveHead As Recordset
Set rstSaveHead = New Recordset
rstSaveHead.Open "SELECT Local_Inventory_Evidence.* FROM Local_Inventory_Evidence where Evidence_Number ='" & BillNO & "'", GetCNLocal, adOpenStatic, adLockOptimistic
With rstSaveHead
    If .RecordCount > 0 Then
          ![OtherStock_ID] = DLookUp("ContactNum", "mis_Customer", "ContactName='" & Me.CombContactName.Text & "'") & ""
          ![Employee1] = DLookUp("contactid", "Mis_Contact", "contactname='" & Me.combEmployee & "'")
          ![Evidence_Number] = Me.txtBillNO.Text
          ![Date] = Format(Me.txtDate.Text, "yyyy-mm-dd")
          ![Delivery_Date] = Format(Me.DTPDelivery_Date.Value, "yyyy-mm-dd")
          ![Delivery_Type] = DLookUp("id", "Mis_ConsignMentMode", "description='" & Nz(Me.CombType.Text, 0) & "'")
          ![Delivery_Address] = Me.txtAddr & ""
          ![Summary] = Me.TxtSummary.Text & ""
          ![Above_ID] = Me.CombAbove_ID.Text & ""
          ![Type] = BillType
          ![Stock_ID] = DLookUp("stock_id", "mis_stock", "description='" & Me.CombStock_ID.Text & "'")
          ![DesStock_ID] = DLookUp("stock_id", "mis_stock", "description='" & Me.CombDesStock_ID.Text & "'")
          .Update
    Else
          .AddNew
          ![OtherStock_ID] = DLookUp("ContactNum", "mis_Customer", "ContactName='" & Me.CombContactName.Text & "'") & ""
          ![Employee1] = DLookUp("contactid", "Mis_Contact", "contactname='" & Me.combEmployee & "'")
          ![Evidence_Number] = Me.txtBillNO.Text
          ![Date] = Format(Me.txtDate.Text, "yyyy-mm-dd")
          ![Delivery_Date] = Format(Me.DTPDelivery_Date.Value, "yyyy-mm-dd")
          ![Delivery_Type] = DLookUp("id", "Mis_ConsignMentMode", "description='" & Nz(Me.CombType.Text, 0) & "'")
          ![Delivery_Address] = Me.txtAddr & ""
          ![Summary] = Me.TxtSummary.Text & ""
          ![Above_ID] = Me.CombAbove_ID.Text & ""
          ![Type] = BillType
          ![Stock_ID] = DLookUp("stock_id", "mis_stock", "description='" & Me.CombStock_ID.Text & "'")
          ![DesStock_ID] = DLookUp("stock_id", "mis_stock", "description='" & Me.CombDesStock_ID.Text & "'")
          .Update
    End If
End With
    SaveHead = 1
    Exit Function
Err_SaveHead:
    SaveHead = 0
    MisMsg "SaveHead Error:" & Err.Description
    Exit Function

End Function
'End Sub


Public Function IsSave() As Integer
 IsSave = 0
 On Error GoTo Err_IsSave
     If IsChange = True And islocal = 0 Then
        If MsgBox("当前数据即将改变,保存吗?", vbYesNoCancel) = vbYes Then
            If Nz(Me.txtBillNO.Text, "") = "" Then
                MsgBox "单据编号不能为空!"
                Exit Function
            End If
        
        
            If clsBill.SaveData(Me.txtBillNO.Text) <> 0 And SaveHead(Me.txtBillNO.Text, BillType) <> 0 Then
                MisMsg Me.txtBillNO.Text & " 数据保存成功!"
                IsChange = False
            Else
                Exit Function
            End If
        End If
    
     End If
     IsChange = False
     IsSave = 1
     Exit Function
Err_IsSave:
    IsSave = 0
    MisMsg "IsSave Error:" & Err.Description
    Exit Function
End Function

Private Sub Form_Unload(Cancel As Integer)
If IsSave = 0 Then
    Cancel = 1
Else
    Cancel = 0
    
End If
End Sub

Private Sub GridSize_KeyPress(KeyAscii As Integer)

⌨️ 快捷键说明

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