📄 frmpdd.frm
字号:
Left = 7485
TabIndex = 28
Tag = "退出"
ToolTipText = "退出"
Top = 30
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 = 6525
TabIndex = 22
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 = 0
TabIndex = 21
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 = 20
Tag = "确认"
ToolTipText = "确认进货单，使之生效"
Top = 45
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "审核[&O]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdToolSave
Height = 465
Left = 1875
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 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 cmdToolQuery
CausesValidation= 0 'False
Height = 465
Left = 3750
TabIndex = 17
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 = 16
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 = 15
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 = 8430
TabIndex = 14
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 = 23
Top = 690
Width = 10215
End
End
Attribute VB_Name = "frmPDD"
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 = "LSPDD" '定义表头名称
Private QueryFlag As Boolean '记录查询状态
Private TableState As String '当前状态
Private Sub SetButtonState(d As Boolean)
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
End Sub
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 RL As New ADODB.Recordset
Dim IIprc, IIIprc, Qty As Single, sum, ssum
If Not CommSaveTable() Then
MsgBox "保存数据时发生错误!", vbExclamation, "错误窗口"
Exit Function
End If
Load frmStoreDif
frmStoreDif.grd1.RemoveAll
frmStoreDif.grd2.RemoveAll
Conn.BeginTrans
If d Then
sSQL = "UPDATE LSPDD SET 确认状态=1 WHERE 表单号='" & Trim(txtPurcode.Text) & "'"
Else
sSQL = "UPDATE LSPDD 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 lspdd 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
Set RL = Nothing
RL.Open "select 商品编码,品名,单位,颜色,尺寸,数量 from 配送中心库存 where 商品编码='" & Trim(RsS("商品编码")) & "' and 颜色='" & Trim(RsS("颜色")) & "' and 尺寸='" & Trim(RsS("尺寸")) & "'", Conn, adOpenStatic, adLockReadOnly
If Not RL.EOF Then
frmStoreDif.grd1.AddItem RL("商品编码") & vbTab & _
RL("品名") & vbTab & _
RL("单位") & vbTab & _
RL("颜色") & vbTab & _
RL("尺寸") & vbTab & _
RL("数量")
End If
If Not InStock(RsS("商品编码"), RsS("品名"), _
RsS("单位"), RsS("颜色"), RsS("尺寸"), _
Qty, RsS("不含税单价"), RsS("含税单价")) Then
MsgBox "确认失败!,请检查数据是否正确!", vbInformation, "提示窗口"
Conn.RollbackTrans
Exit Function
End If
Set RL = Nothing
RL.Open "select 商品编码,品名,单位,颜色,尺寸,数量 from 配送中心库存 where 商品编码='" & Trim(RsS("商品编码")) & "' and 颜色='" & Trim(RsS("颜色")) & "' and 尺寸='" & Trim(RsS("尺寸")) & "'", Conn, adOpenStatic, adLockReadOnly
If Not RL.EOF Then
frmStoreDif.grd2.AddItem RL("商品编码") & vbTab & _
RL("品名") & vbTab & _
RL("单位") & vbTab & _
RL("颜色") & vbTab & _
RL("尺寸") & vbTab & _
RL("数量")
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
Call SetButtonState(d)
Conn.CommitTrans
If GetSetting("LSDSTAR", "库存设置", "盘点提示", "1") = "1" Then
frmStoreDif.Show 1
End If
Unload frmStoreDif
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(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 = ""
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -