📄 frmdhd.frm
字号:
Left = 270
TabIndex = 8
Top = 795
Width = 540
End
Begin VB.Label Label12
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "含税进价金额"
Height = 180
Left = 7335
TabIndex = 7
Top = 4080
Width = 1080
End
End
Begin MSComctlLib.StatusBar stbData
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 14
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 = 15
Top = 0
Width = 10560
_ExtentX = 18627
_ExtentY = 979
_Version = 131073
BorderWidth = 0
BevelInner = 1
Begin Threed.SSCommand cmdToolSave
Height = 465
Left = 1890
TabIndex = 21
Tag = "保存"
ToolTipText = "保存进货单"
Top = 45
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "保存[&S]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolSelect
CausesValidation= 0 'False
Height = 465
Left = 7485
TabIndex = 31
Tag = "退出"
ToolTipText = "退出"
Top = 45
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "选择[&R]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdPrintBill
CausesValidation= 0 'False
Height = 465
Left = 6540
TabIndex = 24
Tag = "下一条"
ToolTipText = "打印单据"
Top = 45
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 = 23
Tag = "新建"
ToolTipText = "新建进货单"
Top = 15
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 = 22
Tag = "确认"
ToolTipText = "确认进货单，使之生效"
Top = 45
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "审核[&O]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolDelete
CausesValidation= 0 'False
Height = 465
Left = 2835
TabIndex = 20
Tag = "删除"
ToolTipText = "删除进货单"
Top = 45
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 = 3765
TabIndex = 19
Tag = "查询"
ToolTipText = "查询表单数据"
Top = 45
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 = 4695
TabIndex = 18
Tag = "上一条"
ToolTipText = "上一条"
Top = 45
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 = 5625
TabIndex = 17
Tag = "下一条"
ToolTipText = "下一条"
Top = 45
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 = 8430
TabIndex = 16
Tag = "退出"
ToolTipText = "退出"
Top = 45
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 = 25
Top = 690
Width = 10215
End
End
Attribute VB_Name = "frmDHD"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::商品订货管理模块::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Option Explicit
Dim i, j As Integer
Private RsTemp As New ADODB.Recordset
Public Rs As New ADODB.Recordset '用于只打开单记录集时
Private Const TableName As String = "LSDHD" '定义表头名称
Private QueryFlag As Boolean '记录查询状态
Private TableState As String '当前状态
Private Function AcceptVil(d As Boolean) As Boolean
On Error GoTo ComErr
Dim N
Dim RsStore As New ADODB.Recordset
Dim RsS As New ADODB.Recordset
Dim IIprc, IIIprc, Qty As Single, sum, ssum
If Not CommSaveTable() Then
MsgBox "保存数据时发生错误!", vbExclamation, "错误窗口"
Exit Function
End If
Conn.BeginTrans
If d Then
sSQL = "UPDATE LSDHD SET 确认状态=1 WHERE 表单号='" & Trim(txtPurcode.Text) & "'"
Else
sSQL = "UPDATE LSDHD SET 确认状态=0 WHERE 表单号='" & Trim(txtPurcode.Text) & "'"
End If
If RunSQL(sSQL) <> 0 Then
MsgBox "确认失败!,请检查数据是否正确!", vbExclamation, "提示窗口"
Conn.RollbackTrans
Exit Function
End If
' sSQL = "select 商品编码,品名,单位,颜色,尺寸,进货数量 as 数量,含税进价 as 单价 from LSDHD where 表单号='" & Trim(txtPurcode.Text) & "'"
' Set RsS = Nothing
' RsS.Open sSQL, Conn, adOpenStatic, adLockReadOnly
'
' While Not RsS.EOF
' If d Then
' Qty = RsS("数量")
' Else
' Qty = -RsS("数量")
' End If
'
' If Not InStock(RsS("商品编码"), RsS("品名"), _
' RsS("单位"), RsS("颜色"), RsS("尺寸"), _
' Qty, RsS("单价")) Then
' MsgBox "确认失败!,请检查数据是否正确!", vbInformation, "提示窗口"
' Conn.RollbackTrans
' Exit Function
' End If
' RsS.MoveNext
' Wend
'接受事务
If Rs.State = adStateClosed Then
cmdToolPrevious.Enabled = False
cmdToolNext.Enabled = False
Else
Rs.Requery
Rs.Find "表单号='" & Trim(txtPurcode.Text) & "'"
End If
If d Then
cmdToolCommit.Caption = "弃审[&O]"
cmdToolSave.Enabled = False
cmdToolDelete.Enabled = False
grdDET.AllowUpdate = False
grdDET.SelectByCell = True
Else
cmdToolCommit.Caption = "审核[&O]"
cmdToolSave.Enabled = True
cmdToolDelete.Enabled = True
grdDET.AllowUpdate = True
grdDET.SelectByCell = False
End If
Conn.CommitTrans
Exit Function
ComErr:
ErrNum = Err.number
MsgBox "确认失败!,请检查数据是否正确!" & vbCrLf & Error$(ErrNum), vbExclamation, "提示窗口"
Conn.RollbackTrans
End Function
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(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 = ""
TxtName.Text = ""
txtIptno.Text = ""
txtIamt.Text = ""
txtQty.Text = ""
txtIamt0.Text = ""
txtRemark.Text = ""
'清空明细
grdDET.Update
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -