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