frm_计量器具检定查询.frm

计量器具管理系统

            Height          =   180
            Left            =   480
            TabIndex        =   25
            Top             =   1740
            Width           =   900
         End
         Begin VB.Label Label16 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Caption         =   "使 用 者："
            ForeColor       =   &H00C00000&
            Height          =   180
            Left            =   2910
            TabIndex        =   24
            Top             =   2100
            Width           =   900
         End
         Begin VB.Label Label19 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Caption         =   "出厂编号："
            ForeColor       =   &H00C00000&
            Height          =   180
            Left            =   5340
            TabIndex        =   23
            Top             =   1740
            Width           =   900
         End
      End
      Begin VB.Label Ljl 
         AutoSize        =   -1  'True
         Caption         =   "共查询到110条记录"
         ForeColor       =   &H00008000&
         Height          =   180
         Left            =   6030
         TabIndex        =   45
         Top             =   810
         Width           =   1530
      End
      Begin VB.Label Label22 
         AutoSize        =   -1  'True
         Caption         =   "计 量 器 具 检 定 信 息 查 询"
         BeginProperty Font 
            Name            =   "华文行楷"
            Size            =   15.75
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000C0&
         Height          =   330
         Left            =   1920
         TabIndex        =   1
         Top             =   120
         Width           =   3825
      End
      Begin VB.Line Line8 
         BorderColor     =   &H80000001&
         X1              =   -30
         X2              =   8530
         Y1              =   1020
         Y2              =   1020
      End
      Begin VB.Line Line2 
         BorderColor     =   &H80000001&
         X1              =   -30
         X2              =   8530
         Y1              =   570
         Y2              =   570
      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 rscx As New ADODB.Recordset
Dim Cx_Sql_Str As String
Public Cxmc As String


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)

    DTPqyrq.Value = rs!qyrq
'    DTPbfrq.Value = rs!bfrq
    Exit Sub
ERR:
    MsgBox ERR.Description, vbCritical, "错误提示"
    Exit Sub
End Sub

Private Sub CmdBc_Click()
    On Error GoTo err1
    If rs.State <> 1 Then Exit Sub
    If rs.RecordCount < 1 Then Exit Sub
    
    
    Dim sjkname As String
    CommonDialog1.DialogTitle = "保存报表文件"
    CommonDialog1.Filter = "*.xls"
    CommonDialog1.ShowSave
    sjkname = CommonDialog1.FileName
    If Trim(sjkname) = "" Then Exit Sub
    Frame2.Visible = True
    RePorts.EtCell1.OpenDoc App.Path & "\report\tjs.eT"
    RePorts.EtCell1.SetAliasCell "bt", "计量器具检定查询结果"
    rs.MoveFirst
    For i = 0 To rs.Fields.Count - 1
        If (i > 1) And (i < (rs.Fields.Count - 1)) Then RePorts.EtCell1.InsertCol 4
    Next i
    For i = 0 To rs.Fields.Count - 1
        RePorts.EtCell1.SetCell 4, i + 2, rs.Fields(i).Name
    Next i
    i = 5
    For j = 1 To rs.RecordCount - 1
        RePorts.EtCell1.InsertRow i
    Next j
    rs.MoveFirst
    Do While rs.EOF = False
        For j = 0 To rs.Fields.Count - 1
            RePorts.EtCell1.SetCell i, j + 2, rs.Fields(j)
        Next j
        i = i + 1
        rs.MoveNext
    Loop
    rs.MoveFirst
    If RePorts.EtCell1.SaveAs(sjkname & ".xls") Then
        MsgBox "保存成功！", vbInformation, "报表保存"
    Else
        MsgBox "报表保存失败！", vbInformation, "报表保存"
    End If
    Unload RePorts
    Frame2.Visible = False
    Exit Sub
err1:
    Unload RePorts
    Frame2.Visible = False
    MsgBox ERR.Description
    Exit Sub
End Sub

Private Sub CmdLl_Click()
On Error GoTo ERR
    Cx_Sql_Str = " select bh as 设备编号 , mc as 设备名称 , bcjdrq as 检定日期 , bcjddw as 检定单位, bcjdjg as 检定结果, zt_h as 检定后设备状态 from jlqjjd " + " where  "
    For i = 1 To gridA.Rows - 1
          gridA.Row = 1
          rscx.Filter = "zdhy='" + Trim(gridA.TextMatrix(i, 1)) + "'"
          If Trim(gridA.TextMatrix(i, 3)) <> "null" Then
              Select Case Trim(rscx!sjlx)
                     Case "字符"
                        If Trim(gridA.TextMatrix(i, 2)) = "like" Then
                            Cx_Sql_Str = Cx_Sql_Str + Trim(rscx!zdm) + " " + Trim(gridA.TextMatrix(i, 2)) + "'%" + Trim(gridA.TextMatrix(i, 3)) + "%'  " + Trim(gridA.TextMatrix(i, 4)) + "  "
                        Else
                            Cx_Sql_Str = Cx_Sql_Str + Trim(rscx!zdm) + " " + Trim(gridA.TextMatrix(i, 2)) + "'" + Trim(gridA.TextMatrix(i, 3)) + "'  " + Trim(gridA.TextMatrix(i, 4)) + "  "
                        End If
                     Case "数字"
                     Cx_Sql_Str = Cx_Sql_Str + Trim(rscx!zdm) + " " + Trim(gridA.TextMatrix(i, 2)) + Trim(gridA.TextMatrix(i, 3)) + "  " + Trim(gridA.TextMatrix(i, 4)) + "  "
                     Case "日期"
                     Cx_Sql_Str = Cx_Sql_Str + Trim(rscx!zdm) + " " + Trim(gridA.TextMatrix(i, 2)) + "#" + Trim(gridA.TextMatrix(i, 3)) + "#  " + Trim(gridA.TextMatrix(i, 4)) + "  "
              End Select
          Else
                Cx_Sql_Str = Cx_Sql_Str + Trim(rscx!zdm) + " " + Trim(gridA.TextMatrix(i, 2)) + "    " + Trim(gridA.TextMatrix(i, 3)) + "  " + Trim(gridA.TextMatrix(i, 4)) + "  "
          
          End If
          rscx.Filter = ""
    Next i
    
    
    Grid.Visible = True
    If rs.State = 1 Then rs.Close
    rs.CursorLocation = adUseClient
    rs.Open Cx_Sql_Str, Conn, adOpenStatic, adLockReadOnly
    If rs.EOF = False Then SSTab1.Tab = 1
    Ljl.Caption = "共查询到 " & rs.RecordCount & " 条记录"
    Set Grid.DataSource = rs
    Exit Sub
ERR:
    MsgBox "查询条件错误!!", vbCritical, "提示"
    SSTab1.Tab = 0
End Sub



Private Sub Command3_Click()
gridA.AddItem ""
gridA.TextMatrix(gridA.Rows - 1, 1) = Trim(rscx!zdhy)

End Sub

Private Sub Command4_Click()
    If gridA.Row > 0 Then gridA.RemoveItem gridA.Row
End Sub

Private Sub DTPqyrq_Change()
    DTPjdrq.Value = DTPqyrq.Value
End Sub

Private Sub Form_Load()
    Me.Top = 100
    Me.Left = 50
    SSTab1.Tab = 0
    Ljl.Caption = ""
    Call grid_ini
    If rscx.State = 1 Then rscx.Close
    rscx.CursorLocation = adUseClient
    rscx.Open "select * from cx_table where CXname='检定信息'", Conn
    Set grid_zd.DataSource = rscx
    cmdll.Caption = "查  询"
End Sub


Private Sub Grid_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, adOpenStatic, adLockReadOnly
                If rst.EOF = False Then
                    RsToText rst
                    Tjddw = Trim(rs!检定单位)
                    Tjdjg = Trim(rs!检定结果)
                    DTPjdrq.Value = rs!检定日期
                    Czt_h.Text = rs!检定后设备状态
                    SSTab1.Tab = 2
                End If
            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 rs.State = 1 Then rs.Close
    rs.CursorLocation = adUseClient
    rs.Open Cx_Sql_Str & " order by " & st, Conn, adOpenStatic, adLockReadOnly
    Set Grid.DataSource = rs

End Sub


''''''''''''''''''''''''''''''''''''****************************************

Sub grid_ini()
    gridA.ColComboList(2) = ">|>=|<|<=|=|<>|like|is"
    gridA.ColComboList(4) = "AND|OR"
    gridA.Rows = 1
End Sub