IFIX5.0关于EXCEL报表的生成程序。。。。 - JK工控人生工控博客技术论文

    Private Sub CFixPicture_Initialize()

    Me.DTPend = Now
    Me.DTPstart = DateAdd("h", -1, Now)

    End Sub


    Private Sub CommandButton1_Click()
    ' On Error GoTo excet

    Dim dtmmonth As String
    Dim startdate As String

    startdate = Format(Me.DTPstart, "yyyy-MM-dd HH:mm:ss")

    '处理月底时间
    'dtmmonth = DateAdd("m", 1, Format(Me.DTPstart, "yyyy-mm") & "-01")
    dtmmonth = Format(Me.DTPend, "yyyy-MM-dd HH:mm:ss")

    If startdate >= dtmmonth Then
    GoTo 100
    End If
    '注意:必须先引用ADO控件
    '-------------------查询语句-------------------------
    Dim Sql As String
    Dim cnADO As ADODB.Connection
    Dim rsADO As Recordset

    '-------------------查询设置-------------------------WHERE后的时间段查询可以套用
    Sql = "SELECT *" & _
    " FROM FIX" & _
    " WHERE (DATETIME>={ts '" & startdate & "'} AND" & _
    " DATETIME<={ts '" & dtmmonth & "'})" & _
    " AND INTERVAL='00:05:00'"
    '-------------------连接并读取数据库-----------------

    Set cnADO = New ADODB.Connection
    Set rsADO = New ADODB.Recordset

    cnADO.ConnectionString = "Provider = Microsoft OLE DB Provider for ODBC Drivers;" & _
    "DSN=FIX Dynamics Historical Data;UID =;PWD =;"
    cnADO.Open

    rsADO.CursorLocation = adUseClient

    rsADO.Open Sql, cnADO, adOpenDynamic, adLockUnspecified, -1 '查询数据

    '-----------------------判断有无数据-------------------------

    If rsADO.RecordCount <= 0 Then
    MsgBox "该时间范围无数据!"
    Exit Sub
    End If

    '-----------------------Excel 报表制作-----------------------

    '运行EXCEL，打开报表模板文件
    Dim msexcel As Excel.Application
    Set msexcel = CreateObject("Excel.Application")
    With msexcel
    .Visible = False '如为FALSE，则不显示EXCEL。
    .Workbooks.Open System.ProjectPath & "\APP\Book.mht", , False '该文件相当于一个报表的模

    板，注意要将该文件中将来

    存放日期值的列设置成日期

    格式。
    .ActiveWorkbook.ActiveSheet.Select
    .DisplayAlerts = False
    '.Wait (Now() + 0.00002)
    End With
    '---------------------------写表头------------------------
    ' msexcel.Selection.Font.Bold = True '设为粗体
    For i = 1 To rsADO.Fields.Count
    msexcel.Cells(2, i) = rsADO.Fields(i - 1).Name
    Next

    If rsADO.BOF Then
    msexcel.Quit
    Set msexcel = Nothing
    rsADO.Close
    cnADO.Close
    MsgBox "查询结果为空，请检查查询条件"
    Exit Sub
    '---------------------------写报表值--------------------------
    Else
    rsADO.MoveFirst
    End If
    ' msexcel.Cells.Range("A2:F6").ClearContents
    i = 3
    While Not rsADO.EOF
    For j = 1 To rsADO.Fields.Count
    If j <> 5 Then
    msexcel.Cells(i, j) = rsADO.Fields(j - 1)
    Else
    msexcel.Cells(i, j) = Format(rsADO.Fields(j - 1), "yyyy-MM-dd HH:mm:ss")
    End If
    Next
    rsADO.MoveNext
    i = i + 1
    Wend
    endandquit:
    rsADO.Close
    cnADO.Close
    ''保存和打印代码
    With msexcel
    '.Wait (Now() + 0.00012)
    .ActiveWorkbook.SaveAs "e:\savereport.mht" '此文件名可按需要进行修改，也可按不同的日

    期存不同的文件名称。
    ' .ActiveWorkbook.PrintOut '如需打印到打印机，则取消本行注册。
    .ActiveWorkbook.Close
    .Quit
    End With
    Set cnADO = Nothing
    Set rsADO = Nothing
    Set msexcel = Nothing
    With Me.WebBrowser1
    .Navigate "e:\savereport.mht"
    .AddressBar = False
    End With

    100
    End Sub　

暂时没有评论

发表评论

登陆网站发表评论

密码：