📄 frm商品编码.frm
字号:
ForeColor = 0
Caption = "查询[&Q]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolDelete
CausesValidation= 0 'False
Height = 465
Left = 2820
TabIndex = 18
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 = 17
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 = 16
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 = 15
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 = 14
Tag = "下一条"
ToolTipText = "打印单据"
Top = 30
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "打印[&P]"
ButtonStyle = 3
BevelWidth = 0
End
End
Begin MSComctlLib.StatusBar stbData
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 23
Top = 5850
Width = 10545
_ExtentX = 18600
_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 = 13229
Key = "RECORDCOUNT"
EndProperty
EndProperty
End
Begin VB.Label Label6
BackColor = &H80000012&
Caption = "Label6"
Height = 4920
Left = 150
TabIndex = 11
Top = 720
Width = 10170
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 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(cmbProvider.Text) = "" Then
DataOK = False
Exit Function
End If
' If Trim(txtRtfno.Text) = "" Then
' DataOK = False
' Exit Function
' End If
' If Trim(txtRptno.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
'在状态条上显示记录信息和状态信息
Private Sub ShowStatus(Flag As Integer)
Select Case Flag
Case 0 '查询记录移动
If Rs.EOF Then
Temp = "已经移到记录末尾了"
ElseIf Rs.BOF Then
Temp = "已经移到记录开始"
Else
Temp = "第" & Rs.AbsolutePosition & "条"
End If
stbData.Panels("状态信息").Text = "总共:" & Rs.RecordCount & _
"条之第: " & Temp
Case 1 '开始查询
stbData.Panels("状态信息").Text = "请输入查询条件:"
Case 2 '请输入新表单
stbData.Panels("状态信息").Text = "请输入新表单:"
Case 3 '保存表单
stbData.Panels("状态信息").Text = "表单保存完毕"
Case 4 '保存表单
stbData.Panels("状态信息").Text = "该表单已经确认"
Case 5
stbData.Panels("状态信息").Text = "该表单已经删除 "
Case Else
stbData.Panels("状态信息").Text = ""
End Select
End Sub
'将表的表头和明细清空
Private Sub ClearTable()
'清空表头
txtPurcode.Text = ""
txtPurdate.Text = ""
cmbProvider.Text = ""
' txtRtfno.Text = ""
' txtRptno.Text = ""
txtIptno.Text = ""
'清空明细
grdDET.Update
grdDET.RemoveAll
End Sub
'刷新表显示
Private Sub RefreshTable(vRs As ADODB.Recordset)
On Error GoTo RefErr
If vRs.EOF Or vRs.BOF Then Exit Sub
grdDET.Update
grdDET.RemoveAll
'表头文本框刷新
txtPurcode.Text = vRs("表单号")
txtPurdate.Text = CStr(Format(vRs("制表日期"), "YYYY-MM-DD 00:00"))
cmbProvider.Text = vRs("厂商编码")
' txtRtfno.Text = vRs("审核员")
' txtRptno.Text = vRs("申报员")
txtIptno.Text = vRs("录入员")
'如果确认状态为真则不允许修改
If vRs("确认状态").Value Then
cmdToolCommit.Enabled = False
cmdToolDelete.Enabled = False
cmdToolSave.Enabled = False
grdDET.AllowUpdate = False
grdDET.SelectByCell = True
Else
cmdToolCommit.Enabled = True
cmdToolDelete.Enabled = True
cmdToolSave.Enabled = True
grdDET.AllowUpdate = True
grdDET.SelectByCell = False
End If
While Not vRs.EOF
Temp = vRs("商品编码") & vbTab & _
vRs("条码") & vbTab & _
vRs("品名") & vbTab & _
vRs("单位") & vbTab & _
vRs("含税进价") & vbTab & _
vRs("税率") & vbTab & _
vRs("进价") & vbTab & _
vRs("零售价") & vbTab & _
vRs("批发价1") & vbTab & _
vRs("批发价2")
grdDET.AddItem Temp
'记录后移
vRs.MoveNext
Wend
stbData.Panels("RECORDCOUNT").Text = "总记录数为:" & vRs.RecordCount
Exit Sub
RefErr:
ErrNum = Err.number
MsgBox "读数据库发生错误!" & vbCrLf & Error$(ErrNum), vbExclamation, "提示窗口"
End Sub
'保存表
Private Function SaveTable() As Boolean
On Error GoTo SaveErr
Dim i
grdDET.MoveFirst
For i = 0 To grdDET.Rows - 1
sSQL = "INSERT INTO " & TableName & " (表单号,制表日期,厂商编码" & _
",录入员,商品编码,条码,品名,单位,进价,税率,含税进价,零售价,批发价1,批发价2)" & _
" VALUES('"
sSQL = sSQL & _
Trim(txtPurcode.Text) & "','" & _
Trim(txtPurdate.Text) & "','" & _
Trim(cmbProvider.Text) & "','" & _
Trim(txtIptno.Text) & "','"
sSQL = sSQL & _
Trim(grdDET.Columns(0).Text) & "','" & _
Trim(grdDET.Columns(1).Text) & "','" & _
Trim(grdDET.Columns(2).Text) & "','" & _
Trim(grdDET.Columns(3).Text) & "'," & _
Val(grdDET.Columns(6).Value) & "," & _
Val(grdDET.Columns(5).Value) & "," & _
Val(grdDET.Columns(4).Value) & "," & _
Val(grdDET.Columns(7).Value) & "," & _
Val(grdDET.Columns(8).Value) & "," & _
Val(grdDET.Columns(9).Value) & ")"
If RunSQL(sSQL) <> 0 Then
SaveTable = False
Exit Function
End If
grdDET.MoveNext
Next i
SaveTable = True
Exit Function
SaveErr:
ErrNum = Err.number
MsgBox "保存数据库发生错误!", vbExclamation, "提示窗口"
End Function
Private Sub cmbProvider_GotFocus()
cmbProvider.DroppedDown = True
End Sub
Private Sub cmbProvider_InitColumnProps()
On Error GoTo LinkErr
Set RsTemp = Nothing
sSQL = "SELECT 厂商编码,厂商名称 FROM 厂商主档"
RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
While Not RsTemp.EOF
cmbProvider.AddItem RsTemp("厂商编码") + vbTab + RsTemp("厂商名称")
RsTemp.MoveNext
Wend
Exit Sub
LinkErr:
MsgBox "初始化数据错误！" & Err.Description, vbExclamation, "错误窗口"
End Sub
'增加新表
Private Sub cmdToolAdd_Click()
On Error Resume Next
TableState = "新建"
grdDET.AllowUpdate = True
grdDET.SelectByCell = False
Set Rs = Nothing
QueryFlag = False
Call ShowStatus(2)
'清除整个表显示
Call ClearTable
txtIptno.Text = UserCode
txtPurcode.Text = GeneratePurcode(TableName)
cmdToolSave.Enabled = True
cmdToolCommit.Enabled = False
cmdToolPrevious.Enabled = False
cmdToolNext.Enabled = False
cmdToolDelete.Enabled = False
txtPurdate.Text = Format(Now, "yyyy-mm-dd")
End Sub
'改变确认状态
'只有审核员才能进行该操作
Private Sub cmdToolCommit_Click()
On Error GoTo ComErr
Temp = "确认之后将不能再作改动,继续吗?"
If MsgBox(Temp, vbQuestion + vbYesNo, "提示窗口") = vbNo Then Exit Sub
Conn.BeginTrans
If Not CommSaveTable() Then
MsgBox "保存数据时发生错误!", vbExclamation, "错误窗口"
Exit Sub
End If
sSQL = "UPDATE 审价单 SET 确认状态=1 WHERE 表单号='" & Trim(txtPurcode.Text) & "'"
If RunSQL(sSQL) <> 0 Then
MsgBox "确认失败!,请检查数据是否正确!", vbExclamation, "提示窗口"
Conn.RollbackTrans
Exit Sub
End If
sSQL = "INSERT INTO 商品主档(商品编码,商品条码,品名,单位,厂商编码,进价,零售价,批发价1,批发价2,税率,含税进价) " & _
" SELECT 商品编码,条码,品名,单位,厂商编码,进价,零售价,批发价1,批发价2,税率,含税进价 FROM 审价单 " & _
" WHERE 表单号='" & txtPurcode.Text & "'"
Cmd.ActiveConnection = Conn
Cmd.CommandText = sSQL
Cmd.Execute
'接受事务
If Rs.State = adStateClosed Then
cmdToolPrevious.Enabled = False
cmdToolNext.Enabled = False
Else
Rs.Requery
Rs.Find "表单号='" & Trim(txtPurcode.Text) & "'"
End If
cmdToolCommit.Enabled = False
cmdToolSave.Enabled = False
cmdToolDelete.Enabled = False
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -