Cjdjg.Enabled = True
End Sub
Private Sub RsToText(rs As ADODB.Recordset)
'On Error GoTo err
    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
            Cjdjg.Text = rst!bcjdjg
            Tjdjg.Text = IIf(IsNull(rst!jdbz), "", rst!jdbz)
        End If
    Else
        Tjddw = Trim(rs!Jddw)
        Cjdjg.Text = Trim(rs!jdjg)
        Tjdjg.Text = IIf(IsNull(rs!jdbz), "", rs!jdbz)
        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)
    Dim rst As New ADODB.Recordset
    If rst.State = 1 Then rst.Close
    rst.Open "select * from jlqjjd where bh='" & Trim(Tbh) & "' and bz='基本信息'", Conn, adOpenDynamic, adLockBatchOptimistic
    If rst.EOF = False Then
        rst!Mc = Trim(Tmc)
        rst!Dwmc = Dwmc
        rst!jlsj = Now
        rst!Bcjddw = Trim(Tjddw.Text)
        '''''
        rst!bcjdjg = Trim(Cjdjg.Text)
        rst!jdbz = Trim(Tjdjg)
        rst!bcjdrq = DTPjdrq.Value
        rst!bz = "基本信息"
        rst.UpdateBatch adAffectAllChapters
    Else
        rst.AddNew
        rst!Bh = Trim(Tbh)
        rst!Mc = Trim(Tmc)
        rst!Dwmc = Dwmc
        rst!jlsj = Now
        rst!zt_h = Trim(CZt.Text)
        rst!Bcjddw = Trim(Tjddw.Text)
        '''''
        rst!bcjdjg = Trim(Cjdjg.Text)
        rst!jdbz = Trim(Tjdjg)
        rst!bcjdrq = DTPjdrq.Value
        rst!bz = "基本信息"
        rst.UpdateBatch adAffectAllChapters
    End If
    rs!Jddw = Trim(Tjddw.Text)
    rs!jdjg = Trim(Tjdjg)
    rs!qyrq = DTPqyrq.Value
'    rs!bfrq = DTPbfrq.Value
    rs!jdrq = DTPjdrq.Value
    rs!Dwmc = Dwmc
    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 Grid.Visible = True Then Grid.Visible = False
    If Trim(Tmc.Text) = "" Then
        MsgBox "計量器具名稱不能為空", vbCritical, "提示"
        Exit Sub
    End If
    If CInt(Val(Tjdzq)) = 0 Then
        MsgBox "檢定周期必須填寫，并且必須為數(shù)字", vbCritical, "提示"
        Exit Sub
    End If
    If Trim(Czqdw.Text) = "" Then
        MsgBox "請選擇檢定周期的單位", vbCritical, "提示"
        Exit Sub
    End If
    Dim rst As New ADODB.Recordset
    If rst.State = 1 Then rst.Close
    rst.CursorLocation = adUseClient
    rst.Open "select * from jlqjxx where bh='" & Trim(Tbh) & "'", Conn, adOpenDynamic, adLockBatchOptimistic
    If rst.EOF = False Then
        TextToRs rst
        rst.UpdateBatch adAffectAllChapters
    Else
        rst.AddNew
        TextToRs rst
        rst.UpdateBatch adAffectAllChapters
        If Cxx.Value = 1 Then
            Dim i  As Integer
            i = CInt(Tsbs.Text)
            Dim j As Integer
            j = 1
            If i > 1 Then
                For j = 1 To i - 1
                    Tbh = Bh_A()
                    rst.AddNew
                    TextToRs rst
                    rst.UpdateBatch adAffectAllChapters
                Next j
            End If
        End If
    End If
    
    Cxx.Visible = False
    Tsbs.Visible = False
    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()
    Grid.Visible = True
    If rs.State = 1 Then rs.Close
    rs.CursorLocation = adUseClient
    rs.Open "select bh as 設(shè)備編號 , mc as 設(shè)備名稱 , lb as 類別 , zb as 種別 , dj as 管理等級, zt as 設(shè)備狀態(tài), ggxh as 規(guī)格型號, clfw as 測量范圍, fdz as 分度值, sccj as 生產(chǎn)廠家, ccbh as 出廠編號, sybm as 使用部門, syz as 使用者, qyrq as 啟用日期 from jlqjxx", Conn, adOpenStatic, adLockReadOnly
    Set Grid.DataSource = rs
End Sub

Private Sub CmdSc_Click()
    If Add <> 0 Then Exit Sub
    If Trim(Tbh) = "" Then Exit Sub
    If MsgBox("是否確認刪除當(dāng)前設(shè)備？", vbYesNo, "提示") = vbYes Then
        Conn.Execute "delete from jlqjxx where bh='" & Trim(Tbh) & "'"
        Conn.Execute "delete from jlqjjd where bh='" & Trim(Tbh) & "'"
        Conn.Execute "delete from jlqjbf where bh='" & Trim(Tbh) & "'"
        Conn.Execute "delete from jlqjwx where bh='" & Trim(Tbh) & "'"
        MsgBox "刪除成功！", vbInformation, "提示"
        Qk
    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
        CmdZj_Click
        Exit Sub
    End If
    Dim rst As New ADODB.Recordset
    If rst.State = 1 Then rst.Close
    rst.CursorLocation = adUseClient
    rst.Open "select * from jlqjxx where bh='" & Trim(Tbh.Text) & "'", Conn
    If rst.EOF = True Then
        MsgBox "在計量器具信息中未找到相關(guān)記錄，不可修改！", vbCritical, "提示"
        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()
    If Grid.Visible = True Then Grid.Visible = False
    If Add <> 0 Then Exit Sub
    Js
    Qk
    Cxx.Visible = True
    Tsbs.Visible = True
    Tbh = Bh_A()
    Add = 1
    CmdZj.Enabled = False
    cmdxg.Enabled = False
   ' CmdCz.Enabled = False
    cmdll.Enabled = False
    cmdsc.Enabled = False
End Sub

Private Sub DTPqyrq_Change()
    DTPjdrq.Value = DTPqyrq.Value
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 "特種設(shè)備"
        CZt.Clear
        CZt.AddItem "啟用"
        CZt.AddItem "禁用"
        Czqdw.Clear
        Czqdw.AddItem "月"
        Czqdw.AddItem "年"
        Czqdw.AddItem "天"
        Cjdjg.Clear
        Cjdjg.AddItem "合格"
        Cjdjg.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
        If rstt.State = 1 Then rstt.Close
        rstt.CursorLocation = adUseClient
        rstt.Open "select jddw from jddw", Conn
        Tjddw.Clear
        Do While rstt.EOF = False
            Tjddw.AddItem Trim(rstt!Jddw)
            rstt.MoveNext
        Loop
        Czb.Clear
        If rstt.State = 1 Then rstt.Close
        rstt.CursorLocation = adUseClient
        rstt.Open "select bmmc from bmxx group by bmmc", Conn
        Csybm.Clear
        Do While rstt.EOF = False
            Csybm.AddItem Trim(rstt!bmmc)
            rstt.MoveNext
        Loop
    Else
        MsgBox "系統(tǒng)尚未設(shè)置單位信息，請設(shè)置單位信息后在執(zhí)行此操作！", vbCritical, "器具管理"
        Exit Sub
    End If
End Sub

Function Bh_A() As String ''''''''''''''''''''''''自動生成單據(jù)號
'    On Error GoTo err:
    Dim xx As Integer
    Dim rst As New ADODB.Recordset
    If rst.State = 1 Then rst.Close
    rst.CursorLocation = adUseClient
    rst.Open "select max(bh) as bh from jlqjxx", Conn
    If rst.EOF = False Then
        xx = CInt(Trim(IIf(IsNull(rst!Bh), "00000", rst!Bh)))
    Else
        xx = 0
    End If
    Bh_A = Format(xx + 1, "00000")
    Exit Function
ERR:
    MsgBox ERR.Description, vbCritical, "提示"
End Function

Private Sub Grid_DblClick()
On Error GoTo ERR
    If rs.State = 1 Then
        If rs.RecordCount > 0 Then
            If Trim(rs!設(shè)備編號) <> "" Then
                Tbh = Trim(rs!設(shè)備編號)
                Dim rst As New ADODB.Recordset
                If rst.State = 1 Then rst.Close
                rst.CursorLocation = adUseClient
                rst.Open "select * from jlqjxx where bh='" & Tbh & "'", Conn
                If rst.EOF = False Then
                    RsToText rst
                End If
                Grid.Visible = False
            End If
        End If
    End If
    Exit Sub
ERR:
    Exit Sub
End Sub

Private Sub Grid_HeadClick(ByVal ColIndex As Integer)
    Dim str As String
    Dim st As String
    str = Grid.Columns.Item(ColIndex).Caption
    st = ""
    Select Case str
        Case "設(shè)備編號"
           st = "bh"
        Case "設(shè)備名稱"
            st = "mc"
        Case "類別"
            st = "lb"
        Case "種別"
            st = "zb"
        Case "管理等級"
            st = "dj"
        Case "設(shè)備狀態(tài)"
            st = "zt"
        Case "規(guī)格型號"
            st = "ggxh"
        Case "測量范圍"
            st = "clfw"
        Case "分度值"
            st = "fdz"
        Case "生產(chǎn)廠家"
            st = "sccj"
        Case "出廠編號"
            st = "ccbh"
        Case "使用部門"
            st = "sybm"
        Case "使用者"
            st = "syz"
        Case "啟用日期"
            st = "qyrq"
     End Select
    If st = "" Then Exit Sub
    If rs.State = 1 Then rs.Close
    rs.CursorLocation = adUseClient
    rs.Open "select bh as 設(shè)備編號 , mc as 設(shè)備名稱 , lb as 類別 , zb as 種別 , dj as 管理等級, zt as 設(shè)備狀態(tài), ggxh as 規(guī)格型號, clfw as 測量范圍, fdz as 分度值, sccj as 生產(chǎn)廠家, ccbh as 出廠編號, sybm as 使用部門, syz as 使用者, qyrq as 啟用日期 from jlqjxx order by " & st, Conn, adOpenStatic, adLockReadOnly
    Set Grid.DataSource = rs

End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
    If Add <> 0 Then Exit Sub
    If KeyAscii = 13 Then
        Dim rst As New ADODB.Recordset
        If rst.State = 1 Then rst.Close
        rst.CursorLocation = adUseClient
        rst.Open "select * from jlqjxx where bh='" & Format(Text3, "00000") & "'", Conn
        If rst.EOF = False Then
            RsToText rst
        End If
    End If
End Sub