📄 发货登记查询.frm
字号:
Begin VB.ComboBox Cmdbjmc
Height = 300
Left = 4680
TabIndex = 9
Top = 480
Width = 2055
End
Begin VB.ComboBox Cmdjm
Height = 300
Left = 1200
TabIndex = 7
Top = 960
Width = 2415
End
Begin VB.ComboBox Cmdsm
Height = 300
Left = 1200
TabIndex = 5
Top = 480
Width = 2415
End
Begin VB.Label Label12
Caption = "发货数量"
Height = 375
Left = -70080
TabIndex = 38
Top = 1440
Width = 855
End
Begin VB.Label Label11
Caption = "发货数量"
Height = 375
Left = 4800
TabIndex = 36
Top = 1440
Width = 855
End
Begin VB.Label Label10
Caption = "发货日期"
Height = 255
Left = -71040
TabIndex = 32
Top = 960
Width = 735
End
Begin VB.Label Label9
Caption = "备件名称"
Height = 255
Left = -71040
TabIndex = 30
Top = 480
Width = 855
End
Begin VB.Label Label8
Caption = "发货信息"
Height = 255
Left = -74760
TabIndex = 27
Top = 1440
Width = 735
End
Begin VB.Label Label7
Caption = "局 名"
Height = 255
Left = -74760
TabIndex = 26
Top = 960
Width = 855
End
Begin VB.Label Label6
Caption = "省 名"
Height = 255
Left = -74760
TabIndex = 25
Top = 480
Width = 735
End
Begin VB.Line Line1
X1 = -68760
X2 = -68640
Y1 = 600
Y2 = 600
End
Begin VB.Label Label5
Caption = "发货信息"
Height = 375
Left = 240
TabIndex = 13
Top = 1440
Width = 975
End
Begin VB.Label Label4
Caption = "发货日期"
Height = 255
Left = 3720
TabIndex = 10
Top = 960
Width = 855
End
Begin VB.Label Label3
Caption = "备件名称"
Height = 375
Left = 3720
TabIndex = 8
Top = 480
Width = 855
End
Begin VB.Label Label2
Caption = "局 名"
Height = 255
Left = 240
TabIndex = 6
Top = 960
Width = 975
End
Begin VB.Label Label1
Caption = "省 名"
Height = 255
Left = 240
TabIndex = 4
Top = 480
Width = 975
End
End
End
Attribute VB_Name = "Frmfhdj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rsls As Recordset
Dim sm, jm, bjmc, shxx, fhsj As String
Dim jfxxid, sl As Long
Dim bh As Boolean
Dim tjrq As String
Private Sub Cmdadd_Click()
On Error GoTo err
'检查数据完成性
If Cmdsm.Text = "" Then
MsgBox "用户省名不能为空！", vbInformation, "信息"
Cmdsm.SetFocus
Exit Sub
Else
sm = Trim(Cmdsm.Text)
End If
If Cmdjm.Text = "" Then
MsgBox "用户局名不能为空！", vbInformation, "信息"
Cmdjm.SetFocus
Exit Sub
Else
jm = Trim(Cmdjm.Text)
End If
If Cmdbjmc.Text = "" Then
MsgBox "备件名称不能为空！", vbInformation, "信息"
Cmdbjmc.SetFocus
Exit Sub
Else
bjmc = Trim(Cmdbjmc.Text)
Dim rsbjmc As Recordset
Set rsbjmc = db.OpenRecordset("select bjmc from bjmc where bjmc='" & bjmc & "'")
If rsbjmc.RecordCount = 0 Then
rsbjmc.AddNew
rsbjmc.Fields!bjmc = bjmc
rsbjmc.Update
Cmdbjmc.AddItem bjmc
Cmdbjmc3.AddItem bjmc
End If
rsbjmc.Close
End If
If Txtsl.Text = "" Then
MsgBox "发货数量不能为空！", vbInformation, "信息"
Txtsl.SetFocus
Exit Sub
Else
sl = CLng(Trim(Txtsl.Text))
End If
fhxx = Trim(Txtfhxx.Text)
fhsj = CStr(Format(DTPick1.Value, "yyyy-mm-dd"))
MousePointer = vbHourglass
'检查局方信息
Dim jfxxbj As Boolean
jfxxbj = False
Dim rs1 As Recordset
Set rs1 = db.OpenRecordset("select * from jfxx")
If rs1.RecordCount > 0 Then
Do While Not rs1.EOF
If rs1.Fields!sm = sm And rs1.Fields!jm = jm Then
jfxxid = rs1.Fields!id
jfxxbj = True
Exit Do
End If
rs1.MoveNext
Loop
End If
If jfxxbj = False Then
rs1.MoveLast
rs1.AddNew
rs1.Fields!sm = sm
rs1.Fields!jm = jm
rs1.Update
rs1.MoveLast
jfxxid = rs1.Fields!id
End If
rs1.Close
Set rs1 = db.OpenRecordset("select * from fhdj where jfxxid=" & _
jfxxid & " and bjmc='" & bjmc & _
"' and sl=" & sl & " and fhsj='" & fhsj & "'")
If rs1.RecordCount > 0 Then
MousePointer = vbDefault
MsgBox "发货记录重复！", vbExclamation, "信息"
Exit Sub
Else
rs1.AddNew
rs1.Fields!jfxxid = jfxxid
rs1.Fields!bjmc = bjmc
rs1.Fields!sl = sl
rs1.Fields!fhxx = fhxx
rs1.Fields!fhsj = fhsj
rs1.Update
If rsls.RecordCount > 0 Then
rsls.MoveLast
End If
rsls.AddNew
rsls.Fields!jfxxid = jfxxid
rsls.Fields!sm = sm
rsls.Fields!jm = jm
rsls.Fields!bjmc = bjmc
rsls.Fields!sl = sl
rsls.Fields!fhxx = fhxx
rsls.Fields!fhsj = fhsj
rsls.Update
Data1.Refresh
End If
rs1.Close
MousePointer = vbDefault
Cmdprint.Enabled = True
Cmdupdate.Enabled = True
Cmddel.Enabled = True
bh = True
'Cmdsm.Text = ""
'Cmdjm.Text = ""
Cmdbjmc.Text = ""
Txtfhxx.Text = ""
'DTPick1.Value = Date
Txtsl.Text = ""
Call biaotou
Exit Sub
err:
MousePointer = vbDefault
MsgBox err.Description, vbExclamation, "错误提示"
End Sub
Private Sub Cmdcx_Click()
Dim rs As Recordset
Dim strsql As String
Dim cxsj1, cxsj2 As String
strsql = ""
cxsj1 = Format(DTPick2, "yyyy-mm-dd")
cxsj2 = Format(DTPick3, "yyyy-mm-dd")
If Chkcx.Value = 1 Then
tjrq = "查询日期：" & Format(DTPick2.Value, "yyyy-mm-dd") & "至" & Format(DTPick3.Value, "yyyy-mm-dd")
Else
tjrq = ""
End If
If Chkcx.Value = 1 Then
strsql = " and fhsj between #" & cxsj1 & "# and #" & cxsj2 & "#"
End If
'备件名称
If Chkbjmc.Value = 1 Then
If Cmdbjmc2.Text <> "" Then
bjmc = Trim(Cmdbjmc2.Text)
If strsql <> "" Then
strsql = strsql & " and bjmc='" & bjmc & "'"
Else
strsql = " and bjmc='" & bjmc & "'"
End If
Else
MsgBox "查询条件备件名称不能为空！", vbExclamation, "错误提示"
MousePointer = vbDefault
Exit Sub
End If
End If
'省名
If Chksm.Value = 1 Then
If Cmdsm2.Text <> "" Then
sm = Trim(Cmdsm2.Text)
If strsql <> "" Then
strsql = strsql & " and sm='" & sm & "'"
Else
strsql = " and sm='" & sm & "'"
End If
Else
MsgBox "查询条件省名不能为空！", vbExclamation, "错误提示"
MousePointer = vbDefault
Exit Sub
End If
End If
'局名
If Chkjm.Value = 1 Then
If Cmdjm2.Text <> "" Then
jm = Trim(Cmdjm2.Text)
If strsql <> "" Then
strsql = strsql & " and jm='" & jm & "'"
Else
strsql = " and jm='" & jm & "'"
End If
Else
MsgBox "查询条件局名不能为空！", vbExclamation, "错误提示"
MousePointer = vbDefault
Exit Sub
End If
End If
db.Execute "delete from temp_fhdj"
strsql = "select sm,jm,fhdj.* from fhdj,jfxx where fhdj.jfxxid=jfxx.id" & strsql
Set rs = db.OpenRecordset(strsql)
If rs.RecordCount > 0 Then
Do While Not rs.EOF
If rsls.RecordCount > 0 Then
rsls.MoveLast
End If
rsls.AddNew
rsls.Fields!sm = rs.Fields!sm
rsls.Fields!jm = rs.Fields!jm
rsls.Fields!bjmc = rs.Fields!bjmc
rsls.Fields!fhsj = rs.Fields!fhsj
rsls.Fields!id = rs.Fields!id
rsls.Fields!jfxxid = rs.Fields!jfxxid
rsls.Fields!sl = rs.Fields!sl
rsls.Fields!fhxx = rs.Fields!fhxx
rsls.Update
rs.MoveNext
Loop
Cmdprint.Enabled = True
Cmddel.Enabled = True
Cmdupdate.Enabled = True
Else
Cmdprint.Enabled = False
Cmddel.Enabled = False
Cmdupdate.Enabled = False
End If
rs.Close
bh = True
Data1.Refresh
Call biaotou
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -