frm_计量器具报废.frm

计量器具管理系统

    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
     
    Dbfrq.Enabled = False
    Tbfshr.Enabled = False
    Tbfyy.Enabled = False
    Tbz.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
    
    Dbfrq.Enabled = True
    Tbfshr.Enabled = True
    Tbfyy.Enabled = True
    Tbz.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)
    If rs!abfid = 1 Then
        Dbfrq.Value = rs!abfrq
        Tbfshr.Text = IIf(IsNull(rs!abfshr), "", rs!abfshr)
        Tbfyy.Text = IIf(IsNull(rs!abfyy), "", rs!abfyy)
        Tbz.Text = IIf(IsNull(rs!abfbz), "", rs!abfbz)
        DTPqyrq.Value = rs!qyrq
'        DTPbfrq.Value = rs!bfrq
    End If
    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 bf 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 & "'"
'        Conn.Execute "delete jlqjxx where bh='" & Bh & "'"
'    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) & "#)"
'        Conn.Execute "delete jlqjxx where bh='" & Bh & "'"
'    End If
    If Trim(Tbfyy.Text) = "" Then
        MsgBox "请输入报废原因!", vbInformation, "提示"
        Exit Sub
    End If
    If MsgBox("是否确认将该设备报废?", vbYesNo, "选择") = vbNo Then Exit Sub
    Conn.Execute "update jlqjxx set abfrq=#" & CStr(Dbfrq.Value) & "#,abfshr='" & Trim(Tbfshr.Text) & "', abfyy='" & Trim(Tbfyy.Text) & "', abfbz='" & Trim(Tbz.Text) & "',abfid=1,zt='报废' where bh='" & Tbh.Text & "'"
    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
    If rs.State = 1 Then rs.Close
    rs.CursorLocation = adUseClient
    rs.Open "select bh as 设备编号 , mc as 设备名称 ,abfrq as 报废日期,abfshr as 报废审核人,abfyy as 报废原因 from jlqjxx where abfid=1", 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
    If Jl = False Then Exit Sub
    If MsgBox("是否确认删除当前计量器具的报废记录？", vbYesNo, "提示") = vbYes Then
        Conn.Execute "update jlqjxx set abfid=0 ,zt='禁用' where bh='" & Trim(Tbh) & "' "
        MsgBox "删除成功！", vbInformation, "提示"
        Qk
        
    End If
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 Grid1.Visible = True Then Grid1.Visible = False
    If Add <> 0 Then Exit Sub
    Js
    'Qk
    Dbfrq.Value = Date
    Grid1.Visible = False
    Add = 1
    CmdZj.Enabled = False
    cmdxg.Enabled = False
    CmdCz.Enabled = False
    cmdll.Enabled = False
    cmdsc.Enabled = False
End Sub

Private Sub Form_Load()
   
    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
        Dwmc = Trim(rst!Dwmc)
'        Jddw = Trim(rst!jydw)
'        Tjddw = Jddw
        Cdj.Clear
        Cdj.AddItem "强制检定"
        Cdj.AddItem "一般管理"
        Cdj.AddItem "特种设备"
        CZt.Clear
        CZt.AddItem "启用"
        CZt.AddItem "禁用"
        Czqdw.Clear
        Czqdw.AddItem "月"
        Czqdw.AddItem "年"
        Czqdw.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
        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
        Sd
    Else
        MsgBox "系统尚未设置单位信息，请设置单位信息后在执行此操作！", vbCritical, "器具管理"
        Exit Sub
    End If
End Sub

   

Private Sub Grid1_DblClick()
On Error GoTo ERR
    If rs.State = 1 Then
        If rs.RecordCount > 0 Then
            If Trim(rs!设备编号) <> "" Then
                Tbh = Trim(rs!设备编号)

                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
        End If
    End If
    Exit Sub
ERR:
    Exit Sub
End Sub

Private Sub Grid1_HeadClick(ByVal ColIndex As Integer)
    Dim str As String
    Dim st As String
    str = Grid1.Columns.Item(ColIndex).Caption
    st = ""
    Select Case str
        Case "设备编号"
           st = "bh"
        Case "设备名称"
            st = "mc"
         
    End Select
    If st = "" Then Exit Sub
    If rs.State = 1 Then rs.Close
    rs.CursorLocation = adUseClient
    rs.Open "select bh as 设备编号 , mc as 设备名称 ,abfrq as 报废日期,abfshr as 报废审核人,abfyy as 报废原因 from jlqjxx where abfid=1  order by " & st, Conn, adOpenStatic, adLockReadOnly
    Set Grid1.DataSource = rs

End Sub

Private Sub Grid1_KeyDown(KeyCode As Integer, Shift As Integer)

On Error GoTo ERR
    If KeyCode <> 13 Then Exit Sub
       If rs.State = 1 Then
        If rs.RecordCount > 0 Then
            If Trim(rs!设备编号) <> "" Then
                Tbh = Trim(rs!设备编号)

                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
        End If
    End If
    Exit Sub
ERR:
    Exit Sub

End Sub

Private Sub Image1_Click()

    If Add <> 0 Then Exit Sub
    Frm_选择记录.Show 1
    If Frm_选择记录.sele = "" Then
        Exit Sub
    End If
    Qk1
    Grid1.Visible = False
    Dim rst As New ADODB.Recordset
    If rst.State = 1 Then rst.Close
    rst.CursorLocation = adUseClient
    rst.Open "select * from jlqjxx where bh='" & Format(Frm_选择记录.sele, "00000") & "'", Conn
    If rst.EOF = False Then
        RsToText rst
        Jl = True
        Bh = rst!Bh
    End If
End Sub

Private Sub Tbh_KeyPress(KeyAscii As Integer)
    If Add <> 0 Then Exit Sub
    If KeyAscii = 13 Then
        Qk1
        Grid1.Visible = False
        Tbh = Format(Tbh, "00000")
        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
            Jl = True
            Bh = rst!Bh
        End If
    End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
    If Add <> 0 Then Exit Sub
    If KeyAscii = 13 Then
        Grid1.Visible = False
        Qk1
        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
            Jl = True
            Bh = rst!Bh
        End If
    End If
End Sub