frm_计量器具台帐本月报废.frm

计量器具管理系统

Private Sub CmdPri_Click()
    If Frame1.Visible = False Then Frame1.Visible = True
    If rsls.State = 1 Then rsls.Close
    Set GridPri.DataSource = Nothing
    rsls.CursorLocation = adUseClient
    rsls.Open "select * from pri where bm='基本信息'", Conn, adOpenDynamic, adLockBatchOptimistic
    Set GridPri.DataSource = rsls
    Frame1.Visible = True
End Sub
 


Private Sub Command1_Click()
On Error GoTo ERR
    Dim D1 As String
    Dim D2 As String

    D1 = Format(Text1.Text, "0000") & "-" & Format(Text2.Text, "00") & "-" & "01"
    If Format(Text2.Text, "00") = "12" Then
        D2 = Format(CStr(CInt(Text1.Text) + 1), "0000") & "-01-01"
    Else
        D2 = Format(Text1.Text, "0000") & "-" & Format(CStr(CInt(Text2.Text) + 1), "00") & "-" & "01"
    End If
    
    Dim st As String
    st = "select"
    If rsls.State <> 1 Then Exit Sub
    rsls.Filter = "xd=1"
    If rsls.RecordCount < 1 Then Exit Sub
    rsls.MoveFirst
    Do While rsls.EOF = False
        Select Case rsls!zdm
            Case "设备编号"
               If st = "select" Then
                    st = st & " bh as 设备编号 "
               Else
                    st = st & ", bh as 设备编号"
               End If
            Case "设备名称"
                If st = "select" Then
                    st = st & " mc as 设备名称 "
               Else
                    st = st & ", mc as 设备名称 "
               End If
            Case "类别"
                If st = "select" Then
                    st = st & " lb as 类别 "
               Else
                    st = st & ", lb as 类别"
               End If
            Case "种别"
                If st = "select" Then
                    st = st & " zb as 种别 "
               Else
                    st = st & ", zb as 种别"
               End If
            Case "管理等级"
                If st = "select" Then
                    st = st & " dj as 管理等级 "
               Else
                    st = st & ", dj as 管理等级"
               End If
                
            Case "设备状态"
                If st = "select" Then
                    st = st & " zt as 设备状态 "
               Else
                    st = st & ", zt as 设备状态 "
               End If
                
            Case "规格型号"
                If st = "select" Then
                    st = st & " ggxh as 规格型号 "
               Else
                    st = st & ", ggxh as 规格型号"
               End If
            Case "测量范围"
            If st = "select" Then
                    st = st & " clfw as 测量范围 "
               Else
                    st = st & ", clfw as 测量范围"
               End If
            Case "分度值"
                If st = "select" Then
                    st = st & " fdz as 分度值 "
               Else
                    st = st & ", fdz as 分度值"
               End If
            Case "生产厂家"
                If st = "select" Then
                    st = st & " sccj as 生产厂家 "
               Else
                    st = st & ", sccj as 生产厂家"
               End If
            Case "出厂编号"
                If st = "select" Then
                    st = st & " ccbh as 出厂编号 "
               Else
                    st = st & ", ccbh as 出厂编号"
               End If
            Case "使用部门"
                If st = "select" Then
                    st = st & " sybm as 使用部门 "
               Else
                    st = st & ", sybm as 使用部门"
               End If
            Case "使用者"
                If st = "select" Then
                    st = st & " syz as 使用者 "
               Else
                    st = st & ", syz as 使用者"
               End If
            Case "启用日期"
                If st = "select" Then
                    st = st & " qyrq as 启用日期 "
               Else
                    st = st & ", qyrq as 启用日期"
               End If
             
            Case "检定周期"
                If st = "select" Then
                    st = st & " cstr([jdzq])+[Zqdw] AS 检定周期"
               Else
                    st = st & ", cstr([jdzq])+[Zqdw] AS 检定周期"
               End If
            Case "检定单位"
                If st = "select" Then
                    st = st & " jddw as 检定单位 "
               Else
                    st = st & ",jddw as 检定单位"
               End If
        End Select
        rsls.MoveNext
    Loop
    rsls.Filter = ""
    rsls.UpdateBatch adAffectAllChapters
    
    st = st & " from jlqjxx   where  bfrq>=#" & D1 & "# and bfrq <#" & D2 & "# order by bfrq "

    If rsPri.State = 1 Then rsPri.Close
    rsPri.CursorLocation = adUseClient
    rsPri.Open st, Conn, adOpenStatic, adLockReadOnly
    
    Frame1.Visible = False


    If rsPri.State <> 1 Then Exit Sub
    If rsPri.RecordCount < 1 Then Exit Sub
    Dim jfhj As Double
    Dim dfhj As Double
    Dim f As Integer
    jfhj = 0
    dfhj = 0
    RePorts.EtCell1.OpenDoc App.Path & "\report\tz.eT"
        RePorts.EtCell1.SetAliasCell "dwmc", "单位名称：" + GetDwmc()
        RePorts.EtCell1.SetAliasCell "zdrq", "报废月份: " & Text1 & "年" & Text2 & "月        制单日期：" + CStr(Date)
        RePorts.EtCell1.SetAliasCell "bt", "本 月 报 废 计 量 器 具 台 帐"
        rsPri.MoveFirst
        For i = 0 To rsPri.Fields.Count - 5
            If (i > 1) And (i < (rsPri.Fields.Count - 5)) Then RePorts.EtCell1.InsertCol 8
        Next i
        For i = 0 To rsPri.Fields.Count - 1
            RePorts.EtCell1.SetCell 4, i + 2, rsPri.Fields(i).Name
        Next i
        i = 5
        For j = 1 To rsPri.RecordCount - 1
            RePorts.EtCell1.InsertRow i
        Next j
        rsPri.MoveFirst
        Do While rsPri.EOF = False
            For j = 0 To rsPri.Fields.Count - 1
                RePorts.EtCell1.SetCell i, j + 2, rsPri.Fields(j)
            Next j
            i = i + 1
            rsPri.MoveNext
        Loop

    RePorts.Show
    Exit Sub
ERR:
  MsgBox ERR.Description

End Sub

Private Sub Command2_Click()
    Frame1.Visible = False
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
    Text1.Text = Format(CStr(Year(Date)), "0000")
    cmdll.Caption = "查  询"
    Ljl.Caption = ""
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 = "lb"
        Case "种别"
            st = "zb"
        Case "管理等级"
            st = "dj"
        Case "设备状态"
            st = "zt"
        Case "规格型号"
            st = "ggxh"
        Case "测量范围"
            st = "clfw"
        Case "分度值"
            st = "fdz"
        Case "生产厂家"
            st = "sccj"
        Case "出厂编号"
            st = "ccbh"
        Case "使用部门"
            st = "sybm"
        Case "使用者"
            st = "syz"
        Case "启用日期"
            st = "qyrq"
         
        Case "检定周期"
            st = "zqdw, jdzq "
        Case "检定单位"
            st = "jddw"
    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