frm_计量器具检定.frm

计量器具管理系统

        If rstt.State = 1 Then rstt.Close
        rstt.CursorLocation = adUseClient
        rstt.Open "select jddw from jddw", Conn
        Tbcjddw.Clear
        Do While rstt.EOF = False
            Tbcjddw.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
        Sd
    Else
        MsgBox "系统尚未设置单位信息，请设置单位信息后在执行此操作！", vbCritical, "器具管理"
        Exit Sub
    End If
End Sub

Function Bh_A() As String ''''''''''''''''''''''''自动生成单据号
'    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 rsa.State = 1 Then
        If rsa.RecordCount > 0 Then
            If Trim(rsa!设备编号) <> "" Then
                Tbh = Trim(rsa!设备编号)

                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
                    DTPbcjdrq.Value = rsa!检定日期
                    Tbcjddw.Text = IIf(IsNull(rsa!检定单位), "", rsa!检定单位)
                    Tbcjdjg.Text = IIf(IsNull(rsa!检定结果), "", rsa!检定结果)
                    Czt_h.Text = IIf(IsNull(rsa!检定后设备状态), "", rsa!检定后设备状态)
                    Bh = rst!Bh
                    Bcjddw = IIf(IsNull(rsa!检定单位), "", rsa!检定单位)
                    Bcjdsj = rsa!检定日期
                    Text1.Text = IIf(IsNull(rsa!备注), "", rsa!备注)
                    Mc = rst!Mc
                    Jl = True
                    Grid.Visible = False
                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 "设备编号"
           st = "bh"
        Case "设备名称"
            st = "mc"
        Case "检定日期"
            st = "bcjdrq"
        Case "检定单位"
            st = "bcjddw"
        Case "检定结果"
            st = "bcjdjg"
        Case "检定后设备状态"
            st = "zt_h"
    End Select
    If st = "" Then Exit Sub
    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='" & Tbh & "' order by " & st, Conn, adOpenStatic, adLockReadOnly
    Set Grid.DataSource = rsa

End Sub

Private Sub Grid_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo ERR
    If KeyCode <> 13 Then Exit Sub
    If rsa.State = 1 Then
        If rsa.RecordCount > 0 Then
            If Trim(rsa!设备编号) <> "" Then
                Tbh = Trim(rsa!设备编号)

                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
                    DTPbcjdrq.Value = rsa!检定日期
                    Tbcjddw.Text = IIf(IsNull(rsa!检定单位), "", rsa!检定单位)
                    Tbcjdjg.Text = IIf(IsNull(rsa!检定结果), "", rsa!检定结果)
                    Czt_h.Text = IIf(IsNull(rsa!检定后设备状态), "", rsa!检定后设备状态)
                    Bh = rst!Bh
                    Bcjddw = IIf(IsNull(rsa!检定单位), "", rsa!检定单位)
                    Bcjdsj = rsa!检定日期
                    Mc = rst!Mc
                    Jl = True
                    Grid.Visible = False
                End If
                Grid.Visible = False
            End If
        End If
    End If
    Exit Sub
ERR:
    Exit Sub

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
                    DTPbcjdrq.Value = rs!检定日期
                    Tbcjddw.Text = IIf(IsNull(rs!检定单位), "", rs!检定单位)
                    Tbcjdjg.Text = IIf(IsNull(rs!检定结果), "", rs!检定结果)
                    Czt_h.Text = IIf(IsNull(rs!检定后设备状态), "", rs!检定后设备状态)
                    Bh = rst!Bh
                    Bcjddw = IIf(IsNull(rs!检定单位), "", rs!检定单位)
                    Bcjdsj = rs!检定日期
                    Jl = True
                    Mc = rst!Mc
                    Grid1.Visible = False
                Else
                    Grid1.Visible = False
                    Jl = False
                End If
            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"
        Case "检定日期"
            st = "bcjdrq"
        Case "检定单位"
            st = "bcjddw"
        Case "检定结果"
            st = "bcjdjg"
        Case "检定后设备状态"
            st = "zt_h"
    End Select
    If st = "" Then Exit Sub
    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   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
                    DTPbcjdrq.Value = rs!检定日期
                    Tbcjddw.Text = IIf(IsNull(rs!检定单位), "", rs!检定单位)
                    Tbcjdjg.Text = IIf(IsNull(rs!检定结果), "", rs!检定结果)
                    Czt_h.Text = IIf(IsNull(rs!检定后设备状态), "", rs!检定后设备状态)
                    Bh = rst!Bh
                    Bcjddw = IIf(IsNull(rs!检定单位), "", rs!检定单位)
                    Bcjdsj = rs!检定日期
                    Jl = True
                    Mc = rst!Mc
                    Grid1.Visible = False
                End If
                Grid1.Visible = False
                Jl = False
            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
    Grid.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
        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
            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 Sub

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

Private Sub Text3_KeyPress(KeyAscii As Integer)
    If Add <> 0 Then Exit Sub
    If KeyAscii = 13 Then
        Qk1
        Grid1.Visible = False
        Grid.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(Text3, "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(Text3, "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