📄 frmchainpddqd.frm
字号:
Height = 180
Left = 735
TabIndex = 10
Top = 4485
Width = 360
End
End
Begin MSComctlLib.StatusBar sb1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 20
Top = 5925
Width = 11550
_ExtentX = 20373
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 3
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 15187
Key = "状态信息"
Object.Tag = "IDmsg"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
TextSave = "2002-10-15"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
TextSave = "11:11"
EndProperty
EndProperty
End
Begin Threed.SSPanel SSPanel1
Align = 1 'Align Top
Height = 555
Left = 0
TabIndex = 21
Top = 0
Width = 11550
_ExtentX = 20373
_ExtentY = 979
_Version = 131073
BorderWidth = 0
BevelInner = 1
Begin Threed.SSCommand cmdSave
Height = 465
Left = 960
TabIndex = 30
Tag = "保存"
ToolTipText = "保存单据"
Top = 45
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "保存[&S]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdExit
CausesValidation= 0 'False
Height = 465
Left = 6525
TabIndex = 28
Tag = "退出"
ToolTipText = "退出"
Top = 45
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "退出[&X]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdNext
CausesValidation= 0 'False
Height = 465
Left = 4680
TabIndex = 27
Tag = "下一条"
ToolTipText = "翻至下一页"
Top = 45
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "下一条[&M]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdPrev
CausesValidation= 0 'False
Height = 465
Left = 3750
TabIndex = 26
Tag = "上一条"
ToolTipText = "翻至上一页"
Top = 45
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "上一条[&U]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdQuery
CausesValidation= 0 'False
Height = 465
Left = 2820
TabIndex = 25
Tag = "查询"
ToolTipText = "查询单据内容"
Top = 45
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "查询[&Q]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdDelete
CausesValidation= 0 'False
Height = 465
Left = 1890
TabIndex = 24
Tag = "删除"
ToolTipText = "删除当前单据"
Top = 45
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "删除[&D]"
ButtonStyle = 3
BevelWidth = 0
End
Begin Threed.SSCommand cmdNew
CausesValidation= 0 'False
Height = 465
Left = 36
TabIndex = 23
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 = 5595
TabIndex = 22
Tag = "下一条"
ToolTipText = "打印单据"
Top = 45
Width = 930
_ExtentX = 1640
_ExtentY = 820
_Version = 131073
ForeColor = 0
Caption = "打印[&P]"
ButtonStyle = 3
BevelWidth = 0
End
End
Begin VB.Label Label6
BackColor = &H80000007&
Caption = "Label6"
Height = 5190
Left = 180
TabIndex = 29
Top = 645
Width = 11085
End
End
Attribute VB_Name = "frmChainPDDQD"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::商品配送管理::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Option Explicit
Private Const TableName As String = "ChainPDDQD"
Private QueryFlag As Boolean '记录查询状态
Private TableState As String '当前状态
Private Temp As String
Private QueryRs As New ADODB.Recordset
Private JD As Single
Private Sub SetButtonState(d As Boolean)
If d Then
cmdSave.Enabled = False
cmdDelete.Enabled = False
grdDET.AllowUpdate = False
grdDET.SelectByCell = True
Else
cmdSave.Enabled = True
cmdDelete.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 I As Integer
Dim RsS As New ADODB.Recordset
Dim sSQL As String, Qty As Single
If Not DataIsOK() Then
MsgBox "表单数据存在错误!", vbExclamation, "提示窗口"
Exit Function
End If
If Not CommSaveTable() Then
MsgBox "保存数据时发生错误!", vbExclamation, "错误窗口"
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Conn.BeginTrans
If d Then
sSQL = "UPDATE " & TableName & " SET 确认状态=1 WHERE 表单号='" & Trim(txtPurcode.Text) & "'"
Else
sSQL = "UPDATE " & TableName & " SET 确认状态=0 WHERE 表单号='" & Trim(txtPurcode.Text) & "'"
End If
Cmd.CommandText = sSQL
Cmd.Execute
' grdDET.MoveFirst
' For i = 0 To grdDET.Rows - 1
' grdDET.Row = i
' If d Then
' Qty = -grdDET.Columns("数量").Value
' Else
' Qty = grdDET.Columns("数量").Value
' End If
'
' If Not InSubStock(txtSuppno.Text, grdDET.Columns("商品编码").Text, grdDET.Columns("商品名称").Text, _
' grdDET.Columns("单位").Text, grdDET.Columns("颜色").Text, grdDET.Columns("尺寸").Text, _
' -Qty, grdDET.Columns("单价").Value, 0) Then
' MsgBox "确认失败!,请检查数据是否正确!", vbInformation, "提示窗口"
' Conn.RollbackTrans
' Exit Function
' End If
' Next i
sSQL = "select 商品编码,品名,单位,颜色,尺寸,配送数量 as 数量,零售价 as 单价 from LSChainPDD 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 InSubStock(txtSuppno, RsS("商品编码"), RsS("品名"), _
RsS("单位"), RsS("颜色"), RsS("尺寸"), _
-Qty, RsS("单价"), 0) Then
MsgBox "确认失败!,请检查数据是否正确!", vbInformation, "提示窗口"
Conn.RollbackTrans
Exit Function
End If
RsS.MoveNext
Wend
'确认，保存，删除
Call SetButtonState(d)
Conn.CommitTrans
Exit Function
ComErr:
ErrNum = Err.number
Conn.RollbackTrans
MsgBox "确认失败!,请检查数据是否正确!" & vbCrLf & Error$(Err.number), vbExclamation, "提示窗口"
End Function
Private Sub ShowPosition()
On Error Resume Next
sb1.Panels(1).Text = "共" & Trim(Str(QueryRs.RecordCount)) & "条,第:" & Trim(Str(QueryRs.AbsolutePosition)) & "条"
End Sub
'进入查询状态
Private Sub BeginQuery()
cmdNew.Enabled = False
cmdSave.Enabled = False
cmdToolCommit.Caption = "弃审[&O]"
cmdDelete.Enabled = False
QueryFlag = True
cmdQuery.Caption = "开始[&Q]"
End Sub
'恢复查询前的状态
Private Sub RestoreState()
Call RefreshTable(" ")
cmdNew.Enabled = True
cmdSave.Enabled = True
cmdToolCommit.Caption = "审核[&O]"
cmdDelete.Enabled = True
cmdQuery.Caption = "查询[&Q]"
End Sub
'完成查询
Private Sub CommitQuery()
On Error GoTo MyErr
Dim strSQL As String
Dim strTemp As String
strSQL = "SELECT 表单号 FROM " & TableName & " WHERE "
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If (Trim(txtPurcode.Text) <> "") Then
strTemp = "表单号 LIKE '" & Trim(txtPurcode.Text) & "' AND "
strSQL = strSQL & strTemp
End If
'配送日期
If (Trim(txtPurdate.Text) <> "") Then
strTemp = " 配送日期 = '" & Trim(txtPurdate.Text) & "' AND "
strSQL = strSQL & strTemp
End If
If Trim(grdDET.Columns(1).Text) <> "" Then
strTemp = " 商品编码 like '" & Trim(grdDET.Columns(1).Text) & "' AND "
strSQL = strSQL & strTemp
End If
'录入员
If (Trim(txtIptno.Text) <> "") Then
strTemp = "录入员 LIKE '" & Trim(txtIptno.Text) & "' AND "
strSQL = strSQL & strTemp
End If
If (Trim(txtSuppno.Text) <> "") Then
strTemp = "分店编码 LIKE '" & Trim(txtSuppno.Text) & "' AND "
strSQL = strSQL & strTemp
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If (Right(Trim(strSQL), 5) = "WHERE") Then
strSQL = Left(Trim(strSQL), Len(Trim(strSQL)) - 5)
Else
strSQL = Left(Trim(strSQL), Len(Trim(strSQL)) - 3)
End If
strSQL = strSQL & " group by 表单号 order by 表单号 desc "
RestoreState
Set QueryRs = Nothing
QueryRs.CursorLocation = adUseClient
QueryRs.Open strSQL, Conn, adOpenDynamic, adLockReadOnly
If (Not QueryRs.EOF) Then
RefreshTable (QueryRs("表单号"))
cmdPrev.Enabled = True
cmdNext.Enabled = True
Else
Call RefreshTable("")
cmdPrev.Enabled = False
cmdNext.Enabled = False
End If
Exit Sub
MyErr:
MsgBox "查询条件或者数据库发生错误,请检查." & Chr(13) & "错误信息:" & Err.Description, vbCritical
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -