📄 frmorder.frm
字号:
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 + -