📄 frmckhp.frm
字号:
_ExtentX = 1244
_ExtentY = 529
IconAlign = 0
Icon = "FrmCKHP.frx":2738
Caption = "保 存"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin CSCommandSCE.CommandSCE CmUpdate
Height = 300
Left = 7209
TabIndex = 32
Top = 645
Width = 705
_ExtentX = 1244
_ExtentY = 529
IconAlign = 0
Icon = "FrmCKHP.frx":2754
Caption = "更 新"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin CSCommandSCE.CommandSCE CoOpen
Height = 300
Left = 5523
TabIndex = 37
Top = 645
Width = 705
_ExtentX = 1244
_ExtentY = 529
IconAlign = 0
Icon = "FrmCKHP.frx":2770
Caption = "打 开"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Label Label17
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "金额合计："
Height = 270
Left = 4500
TabIndex = 43
Top = 2595
Width = 1005
End
Begin VB.Line Line1
X1 = 240
X2 = 3525
Y1 = 1725
Y2 = 1725
End
Begin VB.Label Label15
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "经办人："
Height = 270
Left = 1980
TabIndex = 11
Top = 2565
Width = 1005
End
Begin VB.Label Label7
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "仓管员："
Height = 285
Left = 6645
TabIndex = 6
Top = 2115
Width = 1005
End
Begin VB.Label Label6
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "出库仓："
Height = 285
Left = 6645
TabIndex = 5
Top = 2565
Width = 1005
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "状 态："
Height = 285
Left = 15
TabIndex = 4
Top = 2565
Width = 855
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "客 户："
Height = 285
Left = 2190
TabIndex = 3
Top = 2115
Width = 795
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "单 号："
Height = 285
Left = -45
TabIndex = 2
Top = 2115
Width = 915
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "制单日期："
Height = 285
Left = 3540
TabIndex = 1
Top = 1485
Width = 1005
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "货 品 出 库 单"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 465
Left = 330
TabIndex = 0
Top = 1260
Width = 2940
End
End
Attribute VB_Name = "FrmCKHP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'操作的表：DH_HP出库单、DH_HP出库单明细、DB_FL货品仓
'DH_HP出库单表_所有字段：（单号,制单日期,客户,经办人,仓管员,出库仓,金额合计,状态）
'DH_HP出库单明细表_所有字段：（单号,序号,货品名称,货品规格,数量,单位,单价,金额,货品说明）
Option Explicit
Dim CKDB As Database, CKRs As Recordset
Dim CKSQL, CKMXSQL, SQLck As String
Dim i, Y As Integer 'y变量：值为0时，保存数据；值为1时，判断出库单号是否重复
'过滤Null类型数据
Function NoNull(xValue As Variant) As Variant
If IsNull(xValue) Then
NoNull = ""
Else
NoNull = xValue
End If
End Function
Private Sub CoOpen_Click()
frmCKDCX.Show
Y = 1
TeXH = "1"
End Sub
Private Sub DtpRQ_Change()
TeCKRQ = DtpRQ
End Sub
'定义SQL语句
'CKSQL = "select 单号,制单日期,客户,经办人,仓管员,出库仓,金额合计,状态 from DH_HP出库单"
'CKMXSQL = "select 单号,序号,货品名称,货品规格,数量,单位,单价,金额,货品说明 from DH_HP出库单明细"
Private Sub Form_Load()
CKMXSQL = "select 序号,货品名称,货品规格,数量,单位,单价,金额,货品说明 from DH_HP出库单明细 WHERE 单号=" + "'" + "0" + "'"
Set CKDB = OpenDatabase("D:\DBB\DATA.mdb")
Set CKRs = CKDB.OpenRecordset(CKMXSQL)
Set Data1.Recordset = CKRs
SQLck = "select 分仓编号,货品分仓 from DB_FL货品仓"
Set CKDB = OpenDatabase("D:\DBB\DATA.mdb")
Set CKRs = CKDB.OpenRecordset(SQLck)
Do Until CKRs.EOF
CoCK.AddItem CKRs("货品分仓")
CKRs.MoveNext
Loop
End Sub
'CKSQL = "select 单号,制单日期,客户,经办人,仓管员,出库仓,金额合计,状态 from DH_HP出库单"
'CKMXSQL = "select 单号,序号,货品名称,货品规格,数量,单位,单价,金额,货品说明 from DH_HP出库单明细"
Private Sub CmNew_Click() '新建按钮
Dim SQL As String
CKSQL = "select 单号,制单日期,客户,经办人,仓管员,出库仓,金额合计,状态 from DH_HP出库单"
Set CKDB = OpenDatabase("D:\DBB\DATA.mdb")
Set CKRs = CKDB.OpenRecordset(CKSQL)
i = 1
If CKRs.RecordCount = 0 Then
TeCKDH = 1
Else
CKRs.MoveLast
TeCKDH = CKRs("单号") + 1
End If
TeCKKH = ""
TeJBR = ""
TeJEHJ = "0"
TeCGY = ""
TeCKZT = "待出库"
CoCK = ""
TeXH = 1
SQL = "select 序号,货品名称,货品规格,数量,单位,单价,金额,货品说明 from DH_HP出库单明细 WHERE 单号=" + "'" & TeCKDH + "'"
Set CKDB = OpenDatabase("D:\DBB\DATA.mdb")
Set CKRs = CKDB.OpenRecordset(SQL)
Set Data1.Recordset = CKRs
Y = 0
End Sub
Private Sub CmSave_Click() '保存按钮
Dim SQL As String
If CoCK = "" Then
'MsgBox(prompt[, buttons] [, title] [, helpfile, context])
MsgBox "请选择货品出库仓！", , "提示"
Else
Select Case Y 'Y变量：值为0时，保存数据；值为1时，判断出库单号是否重复
Case 0 '完成数据保存
SQL = "INSERT INTO DH_HP出库单(单号,制单日期,客户,经办人,仓管员,出库仓,金额合计,状态) values" & "('" & TeCKDH + "','" & TeCKRQ + "','" & TeCKKH + "','" & TeJBR + "','" & TeCGY + "','" & CoCK + "','" & TeJEHJ + "','" & TeCKZT + "')"
Set CKDB = OpenDatabase("d:\dbb\data.mdb") '设置数据库路径
CKDB.Execute SQL
CKDB.Close
Y = Y + 1
Case 1
SQL = "select 单号,制单日期,客户,经办人,仓管员,出库仓,金额合计,状态 from DH_HP出库单 WHERE 单号=" + "'" & TeCKDH + "'"
Set CKDB = OpenDatabase("D:\DBB\DATA.mdb")
Set CKRs = CKDB.OpenRecordset(SQL)
If CKRs("单号") = TeCKDH Then
MsgBox "单号已存在！", , "提示"
End If
Y = 1
End Select
'下面的老程序被 SELECT CASE 代替
'If TeCKDH = "" Then
'MsgBox "单号不能空！请 > 新建< "
'Else
' SQL = "select 单号,制单日期,客户,经办人,仓管员,出库仓,状态 from HP出库" ' WHERE 单号=" + "'" & TeCKDH + "'"
' Set CKDB = OpenDatabase("D:\DBB\DATA.mdb")
' Set CKRs = CKDB.OpenRecordset(SQL)
' If CKRs("单号") = TeCKDH Then
' MsgBox "单号已存在！", , "提示"
' Else
' SQL = "INSERT INTO HP出库(单号,制单日期,客户,经办人,仓管员,出库仓,状态) values" & "('" & TeCKDH + "','" & TeCKRQ + "','" & TeCKKH + "','" & TeJBR + "','" & TeCGY + "','" & CoCK + "','" & TeCKZT + "')"
' Set CKDB = OpenDatabase("d:\dbb\data.mdb") '设置数据库路径
' CKDB.Execute SQL
' CKDB.Close
' End If
'End If
End If
'TeCKDH = ""
'TeCKKH = ""
'TeJBR = ""
'TeCGY = ""
'TeCKRQ = ""
'TeCKZT = ""
'CoCK = ""
SQL = "select 序号,货品名称,货品规格,数量,单位,单价,金额,货品说明 from DH_HP出库单明细 WHERE 单号=" + "'" & TeCKDH + "'"
Set CKDB = OpenDatabase("D:\DBB\DATA.mdb")
Set CKRs = CKDB.OpenRecordset(SQL)
Set Data1.Recordset = CKRs
End Sub
Private Sub CmUpdate_Click() '更新按钮
Dim SQL As String
SQL = "UPDATE DH_HP出库单 SET 制单日期=" & "'" & TeCKRQ + "'," + "客户=" + "'" & TeCKKH + "'," + "经办人=" + " '" & TeJBR + "'," + "仓管员=" + " '" & TeCGY + "'," + "金额合计=" + " '" & TeJEHJ + "'" + " WHERE 单号=" + "'" & TeCKDH + "'" '定义SQL操作语句
Set CKDB = OpenDatabase("d:\dbb\data.mdb") '设置数据库路径
CKDB.Execute SQL
CKDB.Close
End Sub
Private Sub CmADD_Click() '加入按钮
Dim SQL As String
TeBZ = " "
SQL = "INSERT INTO DH_HP出库单明细(单号,序号,货品名称,货品规格,数量,单位,单价,金额,货品说明) values" & "('" & TeCKDH + "','" & TeXH + "','" & TeHP + "','" & TeGG + "','" & TeSL + "','" & TeDW + "','" & TeDJ + "','" & TeJE + "','" & TeBZ + "')"
Set CKDB = OpenDatabase("d:\dbb\data.mdb") '设置数据库路径
CKDB.Execute SQL
CKDB.Close
TeJEHJ = Val(TeJEHJ) + Val(TeJE)
TeHP = ""
TeGG = ""
TeSL = ""
TeDJ = ""
TeJE = ""
TeBZ = " "
CKMXSQL = "select 序号,货品名称,货品规格,数量,单位,单价,金额,货品说明 from DH_HP出库单明细 WHERE 单号=" + "'" & TeCKDH + "'"
Set CKDB = OpenDatabase("D:\DBB\DATA.mdb")
Set CKRs = CKDB.OpenRecordset(CKMXSQL)
Set Data1.Recordset = CKRs
TeXH = Val(TeXH) + 1
End Sub
Private Sub DBGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim SQL As String
SQL = "select 序号,货品名称,货品规格,数量,单位,单价,金额,货品说明 from DH_HP出库单明细 WHERE 单号=" + "'" & TeCKDH + "'"
Set CKDB = OpenDatabase("D:\DBB\DATA.mdb")
Set CKRs = CKDB.OpenRecordset(SQL)
Set Data1.Recordset = CKRs
For i = 0 To DBGrid1.RowContaining(Y)
TeXH = CKRs("序号")
TeHP = CKRs("货品名称")
TeGG = CKRs("货品规格")
TeSL = CKRs("数量")
TeDJ = CKRs("单价")
TeJE = CKRs("金额")
TeBZ = CKRs("货品说明")
CKRs.MoveNext
Next i
End Sub
Private Sub CmXZ_Click() '货品选择按钮
frmHPKC.Show
End Sub
Private Sub CmCKCL_Click() '出库处理按钮
Dim DBck As Database
Dim Rsck, RSckmx, Rs As Recordset
Dim SQLck, SQLckmx, SQL As String
If TeCKZT = "待出库" Then
SQLckmx = "select 单号,序号,货品名称,货品规格,数量,单位,单价,金额,货品说明 from DH_HP出库单明细 WHERE 单号=" + "'" & TeCKDH + "'"
Set DBck = OpenDatabase("D:\DBB\DATA.mdb")
Set RSckmx = DBck.OpenRecordset(SQLckmx)
Do Until RSckmx.EOF
SQLck = "select 单号,制单日期,客户,经办人,仓管员,出库仓,金额合计,状态 from DH_HP出库单" ' WHERE 单号=" + "'" & TeCKDH + "'"
Set DBck = OpenDatabase("D:\DBB\DATA.mdb")
Set Rsck = DBck.OpenRecordset(SQLck)
SQL = "UPDATE DB_KC货品 SET 库存量=库存量-" + "'" & RSckmx("数量") & "' WHERE 货品名称=" + "'" & RSckmx("货品名称") & "'" + "AND " + "货品规格=" + "'" & RSckmx("货品规格") & "'" + "AND " + "仓库=" + "'" & CoCK + "'" '定义SQL操作语句
Set DBck = OpenDatabase("d:\dbb\data.mdb") '设置数据库路径
TeXS = SQL
DBck.Execute SQL
RSckmx.MoveNext
Loop
TeCKZT = "已出库"
SQL = "UPDATE DH_HP出库单 SET 状态=" & "'" & TeCKZT + "'" + "WHERE 单号=" + "'" & TeCKDH + "'" '定义SQL操作语句
Set CKDB = OpenDatabase("d:\dbb\data.mdb") '设置数据库路径
CKDB.Execute SQL
CKDB.Close
Else
MsgBox "该单已出过库！不能重复出库", , "提示"
End If
End Sub
Private Sub CmCKMXDel_Click() '删除HP出库明细记录
Dim SQL As String
SQL = "DELETE * FROM DH_HP出库单明细 WHERE 序号=" & "'" & TeXH + "'" + "AND " + "单号=" & "'" & TeCKDH + "'" '定义SQL操作语句
Set CKDB = OpenDatabase("d:\dbb\data.mdb") '设置数据库路径
CKDB.Execute SQL
CKDB.Close
SQL = "select 序号,货品名称,货品规格,数量,单位,单价,金额,货品说明 from DH_HP出库单明细 WHERE 单号=" + "'" & TeCKDH + "'"
Set CKDB = OpenDatabase("D:\DBB\DATA.mdb")
Set CKRs = CKDB.OpenRecordset(SQL)
Set Data1.Recordset = CKRs
End Sub
Private Sub TeHB_Click()
frmHPKC.Show
End Sub
Private Sub RQ_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
End Sub
Private Sub TeSL_Change()
TeJE = Val(TeSL) * Val(TeDJ)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -