frm_计量器具检定.frm

计量器具管理系统

    Tccbh = ""
    Csybm.Text = ""
    Tsyz = ""
    Tjdzq = ""
 
    Tjddw = Jddw
    Tjdjg = ""
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
    Tjddw.Enabled = False
    Tjdjg.Enabled = False
    DTPqyrq.Enabled = False
    DTPbfrq.Enabled = False
    DTPjdrq.Enabled = False
    DTPbcjdrq.Enabled = False
    Tbcjddw.Enabled = False
    Czt_h.Enabled = False
    Tbcjdjg.Enabled = False
    Text1.Enabled = False
End Sub
Private Sub Js()
    Tbh.Enabled = False
    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
    Tjddw.Enabled = False
    Tjdjg.Enabled = False
    DTPqyrq.Enabled = False
    DTPbfrq.Enabled = False
    DTPjdrq.Enabled = False
    DTPbcjdrq.Enabled = True
    Tbcjddw.Enabled = True
    Czt_h.Enabled = True
    Tbcjdjg.Enabled = True
    Text1.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 TextToRs(rs As ADODB.Recordset)
'On Error GoTo err
    rs!Bh = Trim(Tbh)
    rs!Mc = Trim(Tmc)
    rs!zt = Trim(CZt.Text)
    rs!lb = Trim(Clb.Text)
    rs!zb = Trim(Czb.Text)
    rs!dj = Trim(Cdj.Text)
    rs!ggxh = Trim(Tggxh)
    rs!clfw = Trim(Tclfw)
    rs!fdz = Trim(Tfdz)
    rs!sccj = Trim(Tsccj)
    rs!ccbh = Trim(Tccbh)
    rs!sybm = Trim(Csybm.Text)
    rs!syz = Trim(Tsyz)
    rs!Jdzq = CInt(Val(Tjdzq))
    rs!Zqdw = Trim(Czqdw.Text)
    rs!Jddw = Trim(Tjddw)
    rs!jdjg = Trim(Tjdjg)
    rs!qyrq = DTPqyrq.Value
'    rs!bfrq = DTPbfrq.Value
    rs!jdrq = DTPjdrq.Value
    rs!Dwmc = Dwmc
    rs!jdbz = Trim(Text1.Text)
    rs!jlsj = Now
    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(Tbcjddw.Text) = "" Then
        MsgBox "检定单位不能为空!", vbInformation, "提示"
        Exit Sub
    End If
    If Trim(Tbcjdjg.Text) = "" Then
        MsgBox "检定结果不能为空!", vbInformation, "提示"
        Exit Sub
    End If
    If Trim(Czt_h.Text) = "" Then
        MsgBox "请选择检定后设备状态!", vbInformation, "提示"
        Exit Sub
    End If
    If Add = 2 Then
        Conn.Execute "update jlqjjd set bcjdrq=#" & CStr(DTPbcjdrq.Value) & "# ,bcjdjg='" & Trim(Tbcjdjg.Text) & "',bcjddw='" & Trim(Tbcjddw.Text) & "',jdbz='" & Trim(Text1.Text) & "', zt_h='" & Czt_h.Text & "' where bh='" & Bh & "' and bcjdrq=#" & CStr(Bcjdsj) & "# and bcjddw='" & Bcjddw & "'"
    End If
    
    If Add = 1 Then
        Conn.Execute "insert into  jlqjjd(dwmc,bh,mc,zt_h,bcjdrq,bcjddw,bcjdjg,jdbz,jlsj) values('" & Dwmc & "','" & Tbh & "','" & Tmc & "','" & Trim(Czt_h.Text) & "',#" & CStr(DTPbcjdrq.Value) & "#,'" & Tbcjddw.Text & "','" & Tbcjdjg.Text & "','" & Trim(Text1.Text) & "', #" & CStr(Now) & "#)"
        Conn.Execute "update jlqjxx set zt='" & Trim(Czt_h.Text) & "' where bh='" & Tbh.Text & "'"
    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 设备名称 ,bcjdrq as 检定日期,bcjddw as 检定单位,bcjdjg as 检定结果, zt_h as 检定后设备状态 ,jdbz as 备注 from jlqjjd", 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 Jl = False Then Exit Sub
    Grid1.Visible = False
    Grid.Visible = False
    If MsgBox("是否确认删除当前计量器具的检定记录？", vbYesNo, "提示") = vbYes Then
        Conn.Execute "delete from jlqjjd where bh='" & Trim(Tbh) & "' and bcjdrq=#" & CStr(DTPbcjdrq.Value) & "# and bcjddw='" & Tbcjddw & "'"
        MsgBox "删除成功！", vbInformation, "提示"
        Qk
        
        Tbcjddw = ""
        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 设备名称 ,bcjdrq as 检定日期,bcjddw as 检定单位,bcjdjg as 检定结果, zt_h as 检定后设备状态,jdbz as 备注  from jlqjjd where bh='" & Format(Tbh, "00000") & "'", Conn, adOpenStatic, adLockReadOnly
            If rsa.EOF = False Then
                Grid1.Visible = False
                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
    If Add <> 0 Then Exit Sub
    If Trim(Tbh) = "" Then
        Exit Sub
    End If
    If (Jl = False) Or Trim(Bh) = "" Then
        MsgBox "无计量器具检定记录,不可修改!", vbInformation, "提示"
        Exit Sub
    End If
    Grid1.Visible = False
    Grid.Visible = False
    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
    Grid1.Visible = False
    Grid.Visible = False
    If Grid.Visible = True Then Grid.Visible = False
    If Grid1.Visible = True Then Grid1.Visible = False
    If Add <> 0 Then Exit Sub
    Js
    Qk
    DTPbcjdrq.Value = Date
    Tbcjddw = Jddw
    Add = 1
    CmdZj.Enabled = False
    cmdxg.Enabled = False
    CmdCz.Enabled = False
    cmdll.Enabled = False
    cmdsc.Enabled = False
End Sub

Private Sub Form_Load()
    Grid.Visible = False
    Me.Left = 30
    Me.Top = 200
    Add = 0
    badd = False
'    Cxx.Visible = False
'    Tsbs.Visible = False
    Dim rst As New ADODB.Recordset
    If rst.State = 1 Then rst.Close
    rst.CursorLocation = adUseClient
    rst.Open "select * from dwxx", Conn
    If rst.EOF = False Then
        badd = True
        DTPqyrq.Value = Date
        DTPbfrq.Value = Date
        DTPjdrq.Value = Date
        Dwmc = Trim(rst!Dwmc)
'        Jddw = Trim(rst!jydw)
'        Tjddw = Jddw
        Cdj.Clear
        Cdj.AddItem "强制检定"
        Cdj.AddItem "一般管理"
        Cdj.AddItem "特种设备"
        CZt.Clear
        CZt.AddItem "启用"
        CZt.AddItem "禁用"
        Czt_h.Clear
        Czt_h.AddItem "启用"
        Czt_h.AddItem "禁用"
        Czqdw.Clear
        Czqdw.AddItem "月"
        Czqdw.AddItem "年"
        Czqdw.AddItem "天"
        Tbcjdjg.Clear
        Tbcjdjg.AddItem "合格"
        Tbcjdjg.AddItem "不合格"
        Dim rstt As New ADODB.Recordset
        If rstt.State = 1 Then rstt.Close
        rstt.CursorLocation = adUseClient
        rstt.Open "select qjlb from qjzl group by qjlb", Conn
        Clb.Clear
        Do While rstt.EOF = False
            Clb.AddItem Trim(rstt!qjlb)
            rstt.MoveNext
        Loop
        
        Tbcjddw.Clear