frmquery.frm

这是一个实际的工程中所用的源程序

    End If
    Picture1.Top = Frame2.Top + 60

End Sub

'
Private Function CN_Year(ByVal DDate) As String  '数据环境连接
    Dim strCN As String
    strCN = CN_Str40 & PATH_Year(DDate)
     CN_Year = strCN
End Function
Private Function CN_Shape(ByVal DDate As Date) As String  '数据形状连接
    Dim strCN As String
    strCN = Shape_Str40 & PATH_Year(DDate)
    CN_Shape = strCN
End Function
Private Function PATH_Year(ByVal DDate) As String
    PATH_Year = PATH_mdb & "SB" & Format$(DDate, "YYYY") & ".mdb"
End Function
'
'
'
Private Sub Form_Load()
    Dim i As Integer
    On Error GoTo err1
    'MFlex.ToolTipText = "右键点击可以输出设备月报表"
    MFlex.FocusRect = flexFocusNone
    MFlex.HighLight = flexHighlightWithFocus
    MFlex.SelectionMode = flexSelectionByRow
    
    dtpDate(0).Value = Date
'
   Call cmd明细_Click
    Exit Sub
err1:
    Err.Clear
    Resume Next
End Sub
Private Sub cmd明细_Click()
    Dim cmdText As String
    cmdText = getSQL
   ' Debug.Print "查询="; cmdText
    Call toQuery(cmdText)
End Sub
Private Sub mnu月报表_Click() '单机月报表
   If Not IsNumeric(nmRow) Then Exit Sub
    Dim cmdText As String
    cmdText = getSQL1
   ' Debug.Print "单机月报表="; cmdText
    'Call toQuery(cmdText)
    
    
    On Error GoTo err1
    
    If DE.cnSB.State = adStateOpen Then
        DE.cnSB.Close
    End If
    DE.cnSB.ConnectionString = CN_Year(dtpDate(0).Value)
    DE.cnSB.Open
    DE.Commands("JLD").CommandText = cmdText
    
    DE.JLD
    DoEvents
    iRecordCount = DE.rsJLD.RecordCount
    
    If iRecordCount > 0 Then
      Call getSQL3
      With rpt单台
      .Sections("SECTION4").Controls("lbName").Caption = nmSB
      .Sections("SECTION4").Controls("lbTitle").Caption = "单台设备利用率月报( " & dtpDate(0).Month & " 月)"
      .Sections("SECTION5").Controls("lbSum1").Caption = rptSum1
      .Sections("SECTION5").Controls("lbSum2").Caption = rptSum2
      End With
      
      rpt单台.Show vbModal
    
    Else
        MsgBox "没有查询到所要求的记录.", vbExclamation, Me.Caption
    End If
     Exit Sub
err1:
    Debug.Assert False
     Call meErr("frmQuery:单机月报表", Err.Description)
     Err.Clear
     Resume Next
    
End Sub
Private Sub cmd打印_Click() '月报表
    Dim cmdText As String
    cmdText = getSQL2
   ' Debug.Print "月报表="; cmdText
    'Call toQuery(cmdText)
    
    On Error GoTo err1
    
    If DE.cnSB.State = adStateOpen Then
        DE.cnSB.Close
    End If
    DE.cnSB.ConnectionString = CN_Year(dtpDate(0).Value)
    DE.cnSB.Open
    DE.Commands("JLDy").CommandText = cmdText
    
    DE.JLDy
    DoEvents
    iRecordCount = DE.rsJLDy.RecordCount
    
    If iRecordCount > 0 Then
      Dim pg As String
      If Option1(0).Value = True Then
         pg = "2"
      ElseIf Option1(1).Value = True Then
         pg = "3"
      End If
      With rpt全部
      .Sections("SECTION4").Controls("lbTitle").Caption = pg & "#泊位设备利用率月报( " & dtpDate(0).Month & " 月)"
      End With
      
      rpt全部.Show vbModal
    
    Else
        MsgBox "没有查询到所要求的记录.", vbExclamation, Me.Caption
    End If
     Exit Sub
err1:
    Debug.Assert False
     Call meErr("frmQuery:月报表", Err.Description)
     Err.Clear
     Resume Next
End Sub

Private Sub cmd打印x_Click() '月报表
    Dim cmdText As String
    cmdText = getSQL2
    Debug.Print "月报表="; cmdText
    Call toQuery(cmdText)
    
    On Error GoTo err1
    rptTest.DataMember = ""
    Set rptTest.DataSource = adoShape.Recordset
    
    DoEvents
    iRecordCount = adoShape.Recordset.RecordCount
    
    If iRecordCount > 0 Then
      Dim pg As String
      If Option1(0).Value = True Then
         pg = "2"
      ElseIf Option1(1).Value = True Then
         pg = "3"
      End If
      With rptTest
      .Sections("SECTION4").Controls("lbTitle").Caption = pg & "#泊位设备利用率月报( " & dtpDate(0).Month & " 月)"
      End With
      
      rptTest.Show vbModal
    
    Else
        MsgBox "没有查询到所要求的记录.", vbExclamation, Me.Caption
    End If
     Exit Sub
err1:
    Debug.Assert False
     Call meErr("frmQuery:月报表", Err.Description)
     Err.Clear
     Resume Next
End Sub


Private Sub toQuery(ByVal vCmdText As String)
        
    On Error GoTo err1
    
    adoShape.ConnectionString = CN_Year(dtpDate(0).Value)
    adoShape.RecordSource = vCmdText
    adoShape.Refresh
    iRecordCount = adoShape.Recordset.RecordCount
    Me.Caption = "[查询和报表] ---> 记录数:" & CStr(iRecordCount) & " 条"
    If iRecordCount <= 0 Then
       MsgBox "没有查询到所要求的记录.", vbExclamation, Me.Caption
'    MFlex.FormatString = getFormatString(vType) '格式化MFlex的标题
    Else
      Set MFlex.Recordset = adoShape.Recordset
      MFlex.Refresh
      Call FormatMFlex
      Set MFlex.Recordset = Nothing
   End If
    Exit Sub
err1:
    Debug.Assert False
     Call meErr("frmQuery:getQuery", Err.Description)
     Err.Clear
     Resume Next
End Sub
Private Sub FormatMFlex()
'界面预设置:行标头:True,固定行:0,固定列:0,行数:2
'    MFlex.FixedRows = 1
    
            MFlex.ColWidth(0) = 0
            'MFlex.ColAlignment(0) = flexAlignRightCenter
            MFlex.ColWidth(1) = 2100
            MFlex.ColWidth(2) = 1400
            MFlex.ColWidth(3) = 1400
            MFlex.ColAlignment(3) = flexAlignRightCenter
'    MFlex.ColHeader(0) = flexColHeaderOn
'    Select Case vType
'        Case 0 '按日查询
'            MFlex.ColHeaderCaption(0, 0) = "日  期"
'            For i = 1 To TechCount
'            MFlex.ColHeaderCaption(0, i) = NameTech(i)
'            Next i
'            MFlex.ColHeaderCaption(0, i) = "称合计"
'        Case 1 '按班查询
'            MFlex.ColHeaderCaption(0, 0) = "日  期"
'            For i = 1 To TechCount
'            MFlex.ColHeaderCaption(0, i) = NameTech(i)
'            Next i
'            MFlex.ColHeaderCaption(0, i) = "称合计"
'            MFlex.ColHeaderCaption(0, i + 1) = "班  次"
'            MFlex.ColHeaderCaption(0, i + 2) = "时  间"
'    End Select
End Sub
Private Sub MFlex_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim r As Integer
    r = MFlex.Row
    Debug.Print "MFlex.Row="; r
    nmRow = MFlex.TextMatrix(r, 0) '设备号
    nmSB = MFlex.TextMatrix(r, 1) '设备名
End Sub
Private Sub MFlex_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
    PopupMenu mnuPop
End If
End Sub



Private Function getSQL() As String
   Dim vSQL As String
   Dim pg As String
   If Option1(0).Value = True Then
      pg = "2"
   ElseIf Option1(1).Value = True Then
      pg = "3"
   End If
   vSQL = "SELECT "
   vSQL = vSQL & "JLD.[设备号]"
   vSQL = vSQL & ","
   vSQL = vSQL & "SB.[设备名]   AS [设 备 名 称]"
   vSQL = vSQL & ","
   vSQL = vSQL & "JLD.[lng运行] AS [运行时间(秒)]"
   vSQL = vSQL & ","
   vSQL = vSQL & "FORMAT(JLD.[dbl运行] ," & """" & "#0.00" & """" & ") AS [设备利用率(%)]"
   vSQL = vSQL & " "
   vSQL = vSQL & "FROM JLD,SB"
   vSQL = vSQL & " "
   vSQL = vSQL & "WHERE SB.[SER]=JLD.[设备号]"
   vSQL = vSQL & " AND "
   vSQL = vSQL & "JLD.[日期]=#" & dtpDate(0).Value & "#"
   vSQL = vSQL & " AND "
   vSQL = vSQL & "SB.[PAGE]=" & pg
   vSQL = vSQL & " "
   vSQL = vSQL & "ORDER BY JLD.[设备号]"
   getSQL = vSQL
End Function
Private Sub getSQL3()
   Dim vSQL As String
   vSQL = "SELECT "
   vSQL = vSQL & "JLDy.[str运行] AS [运行累计时间]"
   vSQL = vSQL & ","
   vSQL = vSQL & "FORMAT(JLDy.[dbl运行] ," & """" & "#0.00" & """" & ") AS [设备利用率(%)]"
   vSQL = vSQL & " "
   vSQL = vSQL & "FROM JLDy"
   vSQL = vSQL & " "
   vSQL = vSQL & "WHERE JLDy.[设备号]=" & nmRow
   vSQL = vSQL & " AND "
   vSQL = vSQL & "JLDy.[月份]=" & dtpDate(0).Month
   
   Dim cn As ADODB.Connection
   Dim rs As ADODB.Recordset
   Set cn = New ADODB.Connection
   Set rs = New ADODB.Recordset
   cn.ConnectionString = CN_Year(dtpDate(0).Value)
   cn.Open
   rs.CursorLocation = adUseClient
   rs.Open vSQL, cn, adOpenDynamic, adLockOptimistic, adCmdText
   If rs.RecordCount > 0 Then
      rs.MoveFirst
      rptSum1 = rs.Fields(0).Value
      rptSum2 = rs.Fields(1).Value
   End If
   rs.Close
   cn.Close
   Set rs = Nothing
   Set cn = Nothing
   
End Sub

Private Function getSQL2() As String '月报表
'format(dateadd("s",3600*24.0+3600,"1899-12-31 00:00:00"),"DD日HH小时mm分ss秒")

   Dim vSQL As String
   Dim pg As String
   If Option1(0).Value = True Then
      pg = "2"
   ElseIf Option1(1).Value = True Then
      pg = "3"
   End If
   vSQL = "SELECT "
   If pg = "2" Then
   vSQL = vSQL & "JLDy.[设备号] AS 序号"
   ElseIf pg = "3" Then
   vSQL = vSQL & "(JLDy.[设备号]-37) AS 序号"
   End If
   vSQL = vSQL & ","
   vSQL = vSQL & "SB.[设备名]   AS [设 备 名 称]"
   vSQL = vSQL & ","
   vSQL = vSQL & "JLDy.[str运行] AS [运行累计时间]"
   vSQL = vSQL & ","
   vSQL = vSQL & "FORMAT(JLDy.[dbl运行] ," & """" & "#0.00" & """" & ") AS [设备利用率(%)]"
   vSQL = vSQL & " "
   vSQL = vSQL & "FROM JLDy,SB"
   vSQL = vSQL & " "
   vSQL = vSQL & "WHERE SB.[SER]=JLDy.[设备号]"
   vSQL = vSQL & " AND "
   vSQL = vSQL & "JLDy.[月份]=" & dtpDate(0).Month
   vSQL = vSQL & " AND "
   vSQL = vSQL & "SB.[PAGE]=" & pg
   vSQL = vSQL & " "
   vSQL = vSQL & "ORDER BY JLDy.[设备号]"
   getSQL2 = vSQL
End Function
Private Function getSQL1() As String '单机月报表
   Dim vSQL As String
   vSQL = "SELECT "
   vSQL = vSQL & "FORMAT(JLD.[日期]," & """" & "YYYY-MM-DD" & """" & ") AS [日  期]"
   vSQL = vSQL & ","
   'vSQL = vSQL & "SB.[设备名]   AS [设 备 名 称]"
   'vSQL = vSQL & ","
   'vSQL = vSQL & "JLD.[lng运行] AS [运行时间(秒)]"
   'vSQL = vSQL & ","
   vSQL = vSQL & "JLD.[str运行] AS [日 运 行 时 间]"
   vSQL = vSQL & ","
   vSQL = vSQL & "FORMAT(JLD.[dbl运行] ," & """" & "#0.00" & """" & ") AS [日利用率(%)]"
   vSQL = vSQL & " "
   vSQL = vSQL & "FROM JLD"
   vSQL = vSQL & " "
   vSQL = vSQL & "WHERE JLD.[设备号]=" & nmRow
   vSQL = vSQL & " AND "
   vSQL = vSQL & "MONTH(JLD.[日期])=" & dtpDate(0).Month
   vSQL = vSQL & " "
   vSQL = vSQL & "ORDER BY JLD.[日期]" '[日  期]" '
   getSQL1 = vSQL
End Function