📄 frm调进价单.frm
字号:
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 = 11456
EndProperty
EndProperty
End
Begin Threed.SSPanel SSPanel1
Align = 1 'Align Top
Height = 555
Left = 0
TabIndex = 15
Top = 0
Width = 9540
_ExtentX = 16828
_ExtentY = 979
_Version = 131073
BorderWidth = 0
BevelInner = 1
Begin Threed.SSCommand cmdToolExit
CausesValidation= 0 'False
Height = 465
Left = 7470
TabIndex = 24
Tag = "退出"
ToolTipText = "退出"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "退出[&X]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolNext
CausesValidation= 0 'False
Height = 465
Left = 5610
TabIndex = 23
Tag = "下一条"
ToolTipText = "翻至下一页"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "下一条[&M]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolPrevious
CausesValidation= 0 'False
Height = 465
Left = 4680
TabIndex = 22
Tag = "上一条"
ToolTipText = "翻至上一页"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "上一条[&U]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolQuery
CausesValidation= 0 'False
Height = 465
Left = 3750
TabIndex = 21
Tag = "查询"
ToolTipText = "查询单据内容"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "查询[&Q]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolDelete
CausesValidation= 0 'False
Height = 465
Left = 2820
TabIndex = 20
Tag = "删除"
ToolTipText = "删除当前单据"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "删除[&D]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolSave
Height = 465
Left = 1890
TabIndex = 19
Tag = "保存"
ToolTipText = "保存单据"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "保存[&S]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolCommit
Height = 465
Left = 960
TabIndex = 18
Tag = "确认"
ToolTipText = "确认单据，使之生效"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "确认[&O]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolAdd
CausesValidation= 0 'False
Height = 465
Left = 36
TabIndex = 17
Tag = "新建"
ToolTipText = "新建单据"
Top = 36
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "新建[&N]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdPrintBill
CausesValidation= 0 'False
Height = 465
Left = 6540
TabIndex = 16
Tag = "下一条"
ToolTipText = "打印单据"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "打印[&P]"
ButtonStyle = 3
BevelWidth = 0
End
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000015&
ForeColor = &H80000008&
Height = 4980
Left = 75
TabIndex = 13
Top = 690
Width = 9390
End
End
Attribute VB_Name = "frm调进价单"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::进价调整单:::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Option Explicit
Dim I, j As Integer
Public Rs As New ADODB.Recordset '用于只打开单记录集时
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代销市场调进价()
On Error GoTo PrcErr
Dim GoodsNum '记录从某一单据上改动的数量
Dim strOperMsg As String '单据改动信息
'定义新单据的有关信息变量
Dim v已售数量
Dim v售完标志
Dim v售完日期
'开始事务
Conn.BeginTrans
sSQL = "UPDATE " & TableName & " SET 确认状态=1 WHERE 表单号='" & Trim(txtPurcode.Text) & "'"
Cmd.ActiveConnection = Conn
Cmd.CommandText = sSQL
Cmd.Execute
'移到第一条
grdDET.MoveFirst
For I = 0 To grdDET.Rows - 1
'对每一条进行处理
'无意义的调价
If grdDET.Columns(4).Value = grdDET.Columns(5).Value Then
MsgBox "价格未改变，请检查输入是否存在错误!", vbExclamation, "错误窗口"
Conn.RollbackTrans
Exit Sub
End If
'只调未付的
sSQL = "SELECT * FROM 代销进货单 WHERE 有效数量>已付数量 " & _
" AND 商品编码='" & Trim(grdDET.Columns(0).Text) & _
"' AND 进价=" & grdDET.Columns(4).Value & _
" AND 厂商编码='" & Trim(cmbProvider.Text) & "'"
Set RsTemp = Nothing
RsTemp.Open sSQL, Conn, adOpenStatic, adLockOptimistic
If RsTemp.EOF Then
MsgBox "进货单错误，未发现可调商品信息!", vbInformation, "提示窗口"
Conn.RollbackTrans
Exit Sub
End If
'记录需要调价的总数量
Temp = grdDET.Columns(3).Value
'循环至条件满足
While Temp <> 0 And Not RsTemp.EOF
'***************************************************
'退货
'一张单据数量足够调价
If RsTemp("有效数量") - RsTemp("已付数量") >= Temp Then
'记录调价数量
GoodsNum = Temp
Temp = 0
'一张单据不足调价
Else
'记录调价数量
GoodsNum = RsTemp("有效数量") - RsTemp("已付数量")
Temp = Temp - GoodsNum
End If
'***************************************************
'***************************************************
'调价商品均为未售商品
If GoodsNum <= RsTemp("已售数量") Then
'生成进货单中商品均为未售商品
v已售数量 = GoodsNum
Else
'计算调价商品中的已售商品数量
v已售数量 = RsTemp("已售数量")
End If
'***************************************************
'改变有效数量及各种标志
RsTemp("有效数量") = RsTemp("有效数量") - GoodsNum
'改变已售商品数量
RsTemp("已售数量") = RsTemp("已售数量") - v已售数量
If (RsTemp("有效数量") - RsTemp("已售数量")) = 0 Then
RsTemp.Fields("售完标志").Value = True
End If
RsTemp.Update
strOperMsg = strOperMsg & vbCrLf & "修改旧进货单，单号为---" & RsTemp("表单号")
'***********************************************
' 生成进货单
'***********************************************
'新单据标志
If v已售数量 = GoodsNum Then
v售完标志 = 1
Else
v售完标志 = 0
End If
sSQL = "INSERT INTO 代销进货单 (表单号,商品编码,品名,单位,进价金额,售价金额" & _
",进价,零售价,有效数量,进货数量" & _
",制表日期,厂商编码,录入员,确认状态,已售数量,售完标志) " & _
" VALUES('" & Mid(RsTemp("表单号"), 1, 7) & "C" & Trim(txtPurcode.Text) & _
"','" & Trim(grdDET.Columns(0).Text) & _
"','" & Trim(grdDET.Columns(1).Text) & _
"','" & Trim(grdDET.Columns(2).Text) & _
"'," & grdDET.Columns(5).Value * GoodsNum & _
"," & GoodsNum * RsTemp("零售价") & _
"," & grdDET.Columns(5).Value & _
"," & RsTemp("零售价") & _
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -