📄 frm商品配送.frm
字号:
Top = 4080
Width = 720
End
End
Begin MSComctlLib.StatusBar stbData
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 13
Top = 5850
Width = 10560
_ExtentX = 18627
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 2
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 5292
MinWidth = 5292
Key = "状态信息"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 13256
EndProperty
EndProperty
End
Begin Threed.SSPanel SSPanel1
Align = 1 'Align Top
Height = 555
Left = 0
TabIndex = 14
Top = 0
Width = 10560
_ExtentX = 18627
_ExtentY = 979
_Version = 131073
BorderWidth = 0
BevelInner = 1
Begin Threed.SSCommand cmdPrintBill
CausesValidation= 0 'False
Height = 465
Left = 6540
TabIndex = 23
Tag = "下一条"
ToolTipText = "打印单据"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "打印[&P]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolAdd
CausesValidation= 0 'False
Height = 465
Left = 15
TabIndex = 22
Tag = "新建"
ToolTipText = "新建进货单"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "新建[&N]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolCommit
Height = 465
Left = 960
TabIndex = 21
Tag = "确认"
ToolTipText = "确认进货单，使之生效"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "确认[&O]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolSave
Height = 465
Left = 1890
TabIndex = 20
Tag = "保存"
ToolTipText = "保存进货单"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "保存[&S]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolDelete
CausesValidation= 0 'False
Height = 465
Left = 2820
TabIndex = 19
Tag = "删除"
ToolTipText = "删除进货单"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "删除[&D]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolQuery
CausesValidation= 0 'False
Height = 465
Left = 3750
TabIndex = 18
Tag = "查询"
ToolTipText = "查询表单数据"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "查询[&Q]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolPrevious
CausesValidation= 0 'False
Height = 465
Left = 4680
TabIndex = 17
Tag = "上一条"
ToolTipText = "上一条"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "上一条[&U]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolNext
CausesValidation= 0 'False
Height = 465
Left = 5610
TabIndex = 16
Tag = "下一条"
ToolTipText = "下一条"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "下一条[&M]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolExit
CausesValidation= 0 'False
Height = 465
Left = 7470
TabIndex = 15
Tag = "退出"
ToolTipText = "退出"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "退出[&X]"
ButtonStyle = 3
BevelWidth = 0
End
End
Begin VB.Label Label6
BackColor = &H80000007&
Caption = "Label6"
Height = 5085
Left = 180
TabIndex = 24
Top = 690
Width = 10215
End
End
Attribute VB_Name = "frm商品配送"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::商品配送单::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Option Explicit
Public Rs As New ADODB.Recordset '用于只打开单记录集时
Dim i, j As Integer
Private Const TableName As String = "商品配送单" '定义表头名称
Private QueryFlag As Boolean '记录查询状态
Private TableState As String '当前状态
Private Function CommSaveTable() As Boolean
On Error GoTo CommSaveErr
sSQL = "DELETE FROM " & TableName & " WHERE 表单号='" & txtPurcode.Text & "'"
Cmd.ActiveConnection = Conn
Cmd.CommandText = sSQL
Cmd.Execute
If SaveTable() Then
CommSaveTable = True
Exit Function
Else
CommSaveTable = False
Exit Function
End If
CommSaveErr:
CommSaveTable = False
End Function
'确认操作
'优惠调价
Private Sub Oper配送()
Dim RsTemp As New ADODB.Recordset
Dim DataOK As Boolean
Dim R As New ADODB.Recordset
Dim GoodsNum, Iprc, IIprc, Rprc
Dim strOperMsg As String
Dim N
On Error GoTo CommitErr
Conn.BeginTrans
sSQL = "UPDATE 商品配送单 SET 确认状态=1 WHERE 表单号='" & txtPurcode.Text & "'"
If RunSQL(sSQL) <> 0 Then
MsgBox "确认失败!,请检查数据是否正确!" & vbCrLf & Error$(ErrNum), vbExclamation, "提示窗口"
Conn.RollbackTrans
Exit Sub
End If
Cmd.ActiveConnection = Conn
grdDET.MoveFirst
For N = 0 To grdDET.Rows - 1
GoodsNum = grdDET.Columns("数量").Value
sSQL = "SELECT 商品编码,进价,含税进价,零售价 FROM 商品主档 WHERE 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "'"
Set RsTemp = Nothing
RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
Iprc = RsTemp("进价")
IIprc = RsTemp("含税进价")
Rprc = RsTemp("零售价")
sSQL = "SELECT 数量 FROM 配送中心库存 WHERE 经营方式='经销' AND 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "'"
Set RsTemp = Nothing
RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
If GetSetting("进销存管理系统", "库存设置", "允许负库存销售", "1") <> "1" Then
If GoodsNum > RsTemp("数量") Then
Conn.RollbackTrans
MsgBox "库存数量不足！", vbExclamation, "提示窗口"
Exit Sub
End If
End If
sSQL = "SELECT * FROM 配送中心库存 WHERE 商品编码='" & Trim(grdDET.Columns(0).Text) & "'" & _
" AND 经营方式='经销'"
Set RsTemp = Nothing
RsTemp.Open sSQL, Conn, adOpenStatic, adLockOptimistic
If RsTemp.EOF Then
MsgBox "未发现该商品的库存信息！", vbInformation, "提示窗口"
Conn.RollbackTrans
Exit Sub
'存在,对库存进行更新
Else
RsTemp("数量") = RsTemp("数量") - GoodsNum
RsTemp("进价金额") = RsTemp("进价金额") - GoodsNum * Iprc
RsTemp("含税进价金额") = RsTemp("含税进价金额") - GoodsNum * IIprc
RsTemp("售价金额") = RsTemp("售价金额") + grdDET.Columns("金额").Value
RsTemp.Update
End If
' sSQL = "UPDATE 配送中心库存 SET 数量=数量-" & GoodsNum & ",进价金额=进价金额-" & GoodsNum * Iprc & ",含税进价金额=含税进价金额-" & GoodsNum * IIprc & _
' ",售价金额=售价金额-" & Rprc * GoodsNum & " WHERE 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "' AND 经营方式='经销'"
' Cmd.CommandText = sSQL
' Cmd.Execute
grdDET.MoveNext
Next N
cmdToolCommit.Enabled = False
cmdToolSave.Enabled = False
cmdToolDelete.Enabled = False
Conn.CommitTrans
Exit Sub
CommitErr:
Conn.RollbackTrans
MsgBox "确认失败!,请检查数据是否存在错误!" & vbCrLf & Err.Description, vbExclamation, "警告窗口"
End Sub
'
'检查数据是否合法
'
Private Function DataOK() As Boolean
If Trim(txtPurcode.Text) = "" Then
DataOK = False
Exit Function
End If
If Trim(txtPurdate.Text) = "" Then
DataOK = False
Exit Function
End If
If Trim(cmbChain.Text) = "" Then
DataOK = False
Exit Function
End If
If Trim(txtIptno.Text) = "" Then
DataOK = False
Exit Function
End If
If grdDET.Rows = 0 Then
DataOK = False
Exit Function
End If
DataOK = True
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -