📄 frm_计量器具维修.frm
字号:
TabIndex = 18
Top = 1635
Width = 900
End
Begin VB.Label Label11
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "使用部门："
Height = 180
Left = 180
TabIndex = 17
Top = 2355
Width = 900
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "启用日期："
Height = 180
Left = 4680
TabIndex = 16
Top = 2355
Width = 900
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "设备名称："
Height = 180
Left = 2490
TabIndex = 14
Top = 915
Width = 900
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "设备种别："
Height = 180
Left = 2490
TabIndex = 13
Top = 1275
Width = 900
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "设备状态："
Height = 180
Left = 4680
TabIndex = 12
Top = 915
Width = 900
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "测量范围："
Height = 180
Left = 2490
TabIndex = 11
Top = 1635
Width = 900
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "规格型号："
Height = 180
Left = 180
TabIndex = 7
Top = 1635
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "管理等级："
Height = 180
Left = 4680
TabIndex = 6
Top = 1275
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "设备类别："
Height = 180
Left = 180
TabIndex = 5
Top = 1275
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "设备编号："
Height = 180
Left = 180
TabIndex = 4
Top = 915
Width = 900
End
End
End
Attribute VB_Name = "Frm_计量器具维修"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As New ADODB.Recordset
Dim Add As Integer
Dim badd As Boolean
Dim Dwmc As String
Dim Jddw As String
Dim rsa As New ADODB.Recordset
Dim WXdw As String
Dim WXsj As Date
Dim Bh As String
Dim Mc As String
Dim Jl As Boolean
Private Sub Qk()
DTPwxrq = Date
Twxdw = ""
Twxr.Text = ""
Twxyy.Text = ""
Twxjg = ""
End Sub
Private Sub Qk1()
DTPwxrq = Date
Twxdw = ""
Twxr.Text = ""
Twxyy.Text = ""
Twxjg = ""
Tmc = ""
CZt.Text = ""
Clb.Text = ""
Czb.Text = ""
Tggxh = ""
Tclfw = ""
Tfdz = ""
Tsccj = ""
Tccbh = ""
Csybm.Text = ""
Tsyz = ""
Tjdzq = ""
End Sub
Private Sub Sd()
Tbh.Enabled = True
Tmc.Enabled = False
CZt.Enabled = False
Clb.Enabled = False
Czb.Enabled = False
Cdj.Enabled = False
Tggxh.Enabled = False
Tclfw.Enabled = False
Tfdz.Enabled = False
Tsccj.Enabled = False
Tccbh.Enabled = False
Csybm.Enabled = False
Tsyz.Enabled = False
Tjdzq.Enabled = False
Czqdw.Enabled = False
DTPqyrq.Enabled = False
DTPbfrq.Enabled = False
DTPwxrq.Enabled = False
Twxdw.Enabled = False
Twxr.Enabled = False
Twxyy.Enabled = False
Twxjg.Enabled = False
End Sub
Private Sub Js()
Tbh.Enabled = True
Tmc.Enabled = False
CZt.Enabled = False
Clb.Enabled = False
Czb.Enabled = False
Cdj.Enabled = False
Tggxh.Enabled = False
Tclfw.Enabled = False
Tfdz.Enabled = False
Tsccj.Enabled = False
Tccbh.Enabled = False
Csybm.Enabled = False
Tsyz.Enabled = False
Tjdzq.Enabled = False
Czqdw.Enabled = False
DTPqyrq.Enabled = False
DTPbfrq.Enabled = False
DTPwxrq.Enabled = True
Twxdw.Enabled = True
Twxr.Enabled = True
Twxyy.Enabled = True
Twxjg.Enabled = True
End Sub
Private Sub RsToText(rs As ADODB.Recordset)
'On Error GoTo err
'Qk1
Tbh = Trim(rs!Bh)
Tmc = Trim(rs!Mc)
CZt.Text = Trim(rs!zt)
Clb.Text = Trim(rs!lb)
Czb.Text = Trim(rs!zb)
Cdj.Text = Trim(rs!dj)
Tggxh = Trim(rs!ggxh)
Tclfw = Trim(rs!clfw)
Tfdz = Trim(rs!fdz)
Tsccj = Trim(rs!sccj)
Tccbh = Trim(rs!ccbh)
Csybm.Text = Trim(rs!sybm)
Tsyz = Trim(rs!syz)
Tjdzq = Trim(rs!Jdzq)
Czqdw.Text = Trim(rs!Zqdw)
'''' Dim rst As New ADODB.Recordset '提取检测信息
'''' Dim str As String
'''' If rst.State = 1 Then rst.Close
'''' rst.CursorLocation = adUseClient
'''' rst.Open "select max(bcjdrq) as jdrq from jlqjjd where bh='" & Trim(rs!Bh) & "'", Conn
'''' If IsNull(rst!jdrq) = False Then
'''' DTPjdrq.Value = rst!jdrq
'''' rst.Close
'''' rst.CursorLocation = adUseClient
'''' rst.Open "select * from jlqjjd where bh='" & Trim(rs!Bh) & "' and bcjdrq=#" & DTPjdrq.Value & "#", Conn
'''' If rst.EOF = False Then
'''' Tjddw.Text = rst!Bcjddw
'''' Tjdjg.Text = rst!bcjdjg
'''' End If
'''' Else
'''' Tjddw = Trim(rs!Jddw)
'''' Tjdjg = Trim(rs!jdjg)
'''' DTPjdrq.Value = rs!jdrq
'''' End If
DTPqyrq.Value = rs!qyrq
' DTPbfrq.Value = rs!bfrq
Exit Sub
ERR:
MsgBox ERR.Description, vbCritical, "错误提示"
Exit Sub
End Sub
Private Sub Clb_Click()
If Trim(Clb.Text) <> "" Then
Dim rstt As New ADODB.Recordset
If rstt.State = 1 Then rstt.Close
rstt.CursorLocation = adUseClient
rstt.Open "select qjzb from qjzl where qjlb='" & Trim(Clb.Text) & "' group by qjzb", Conn
Czb.Clear
Do While rstt.EOF = False
Czb.AddItem Trim(rstt!qjzb)
rstt.MoveNext
Loop
End If
End Sub
Private Sub CmdBc_Click()
If Add = 0 Then Exit Sub
If Trim(Twxdw) = "" Then
MsgBox "维修单位不能为空!", vbInformation, "提示"
Exit Sub
End If
If Add = 2 Then
Conn.Execute "update jlqjwx set wxrq=#" & CStr(DTPwxrq.Value) & "# ,wxdw='" & Trim(Twxdw.Text) & "',wxr='" & Trim(Twxr.Text) & "', wxyy='" & Twxyy & "', wxjg='" & Twxjg & "' ,jlsj=#" & CStr(Now) & "# where bh='" & Tbh & "' and wxrq=#" & CStr(WXsj) & "# and wxdw='" & WXdw & "'"
End If
If Add = 1 Then
Conn.Execute "insert into jlqjwx(dwmc,bh,mc,wxrq,wxdw,wxr,wxyy,wxjg,jlsj) values('" & Dwmc & "','" & Tbh & "','" & Tmc & "',#" & CStr(DTPwxrq.Value) & "# ,'" & Twxdw & "','" & Twxr & "','" & Twxyy & "','" & Twxjg & "', #" & CStr(Now) & "#)"
End If
MsgBox "保存成功！", vbInformation, "提示"
Sd
Add = 0
CmdZj.Enabled = True
cmdxg.Enabled = True
CmdCz.Enabled = True
cmdsc.Enabled = True
cmdll.Enabled = True
End Sub
Private Sub CmdLl_Click()
Grid1.Visible = True
Grid.Visible = False
If rs.State = 1 Then rs.Close
rs.CursorLocation = adUseClient
rs.Open "select bh as 设备编号 , mc as 设备名称 ,wxrq as 维修日期,wxdw as 维修单位,wxr as 维修人, wxyy as 维修原因, wxjg as 维修结果 from jlqjwx", Conn, adOpenStatic, adLockReadOnly
Set Grid1.DataSource = rs
End Sub
Private Sub CmdSc_Click()
If Add <> 0 Then Exit Sub
If Trim(Tbh) = "" Then Exit Sub
If Trim(Twxdw.Text) = "" Then Exit Sub
Grid1.Visible = False
Grid.Visible = False
If Jl = False Then Exit Sub
If MsgBox("是否确认删除当前计量器具的维修记录？", vbYesNo, "提示") = vbYes Then
Conn.Execute "delete from jlqjwx where bh='" & Trim(Tbh) & "' and wxrq=#" & CStr(DTPwxrq.Value) & "# and wxdw='" & Twxdw & "'"
MsgBox "删除成功！", vbInformation, "提示"
Qk
Twxdw = ""
Dim rst As New ADODB.Recordset
If rst.State = 1 Then rst.Close
rst.CursorLocation = adUseClient
rst.Open "select * from jlqjxx where bh='" & Format(Tbh, "00000") & "'", Conn
If rst.EOF = False Then
RsToText rst
If rsa.State = 1 Then rsa.Close
rsa.CursorLocation = adUseClient
rsa.Open "select bh as 设备编号 , mc as 设备名称 ,wxrq as 维修日期,wxdw as 维修单位,wxr as 维修人, wxyy as 维修原因, wxjg as 维修结果 from jlqjwx where bh='" & Format(Tbh, "00000") & "'", Conn, adOpenStatic, adLockReadOnly
If rsa.EOF = False Then
Grid.Visible = True
Set Grid.DataSource = rsa
Bh = rst!Bh
Tbh = rst!Bh
Else
Jl = False
Bh = rst!Bh
Tbh = rst!Bh
End If
End If
End If
End Sub
Private Sub CmdXg_Click()
If Grid.Visible = True Then Grid.Visible = False
Grid1.Visible = False
If Add <> 0 Then Exit Sub
If Trim(Tbh) = "" Then
Exit Sub
End If
If (Jl = False) Or Trim(Twxdw) = "" Then
MsgBox "无计量器具维修记录,不可修改!", vbInformation, "提示"
Exit Sub
End If
Js
Add = 2
CmdZj.Enabled = False
cmdxg.Enabled = False
CmdCz.Enabled = False
cmdsc.Enabled = False
cmdll.Enabled = False
End Sub
Private Sub CmdZj_Click()
Dim rst As New ADODB.Recordset
If rst.State = 1 Then rst.Close
rst.CursorLocation = adUseClient
rst.Open "select * from jlqjxx where bh='" & Format(Trim(Tbh.Text), "00000") & "'", Conn
If rst.EOF = True Then
MsgBox "没有计量器具基本信息，不可进行维修！", vbInformation, "提示"
Exit Sub
End If
If Grid.Visible = True Then Grid.Visible = False
If Grid1.Visible = True Then Grid1.Visible = False
If Add <> 0 Then Exit Sub
Js
Qk
DTPwxrq.Value = Date
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -