发表于:2006-09-08 16:58:00
6楼
具体的代码可参见:
Private Sub CommandButton1_Click()
'注释: 1。该程序需要安装ADO 2.0目标库并在本机注册
' 2。Microsoft ActiveX Data Objects 2.1 Library 必须被引用 (Office 2000)
' 3。Microsoft Excel 9.0 object libraries 必须被引用 (Office 2000)
' 4。划===处可根据具体报表修改
Dim strQueryAvg As String
Dim c As Integer
Dim r As Integer
Dim Intyexcel As Excel.Application
Dim MyDate, MyMonth, MyDay, MyHour, MyMinute, MySecond
Dim StartTime, EndTime, Duration, DisplayDay, DisplayMonth As String
'++===================================================================
'报表中的 TAG
Dim Tag1, Tag2, Tag3, Tag4, Tag5, Tag6, Tag7, Tag8 As String
Dim Items As Integer
Tag1 = "TEST"
Tag2 = "TEST1"
Tag3 = " "
Tag4 = " "
Tag5 = " "
Tag6 = " "
Tag7 = " "
Tag8 = " "
'从历史库中取得域项, 2 - DATATIME, VALUE, TAG 共三项
Items = 2
'--====================================================================
MyDate = Format (Now() - 1, "yyyy-mm-dd")
StartTime = & MyDate & " " & "00:00:00"
EndTime = & MyDate & " " & "23:00:00"
'++==========================================================================
'查询,根据报表修改
strQueryAvg = "Select DATETIME, VALUE, TAG FROM FIX " & _
"WHERE MODE = 'AVERAGE' and (TAG='" & Tag1 & "' or TAG='" & Tag2 & "'" & _
" or TAG='" & Tag3 & "' or TAG='" & Tag4 & "' or TAG='" & Tag5 & "'" & _
" or TAG='" & Tag6 & "' or TAG='" & Tag7 & "' or TAG='" & Tag8 & "')" & _
"and INTERVAL = '01:00:00' and " & _
"(DATETIME >= {ts '" & StartTime & "'} and " & _
"DATETIME <= {ts '" & EndTime & "'})"
'--===========================================================================
Dim cnADO As New ADODB.Connection
Dim rsADO As Recordset
Set cnADO = New ADODB.Connection
cnADO.ConnectionString = "DSN = FIX Dynamics Historical Data; UID = sa; PWD = ;"
cnADO.Open "FIX Dynamics Historical Data", "sa", ""
Set rsADO = New ADODB.Recordset
rsADO.Open strQueryAvg, cnADO, adOpenForwardOnly, adLockBatchOptimistic
r = 1
Set Intyexcel = New Excel.Application
Intyexcel.Visible = False
'++============================================================================
'打开的报表文件名
Dim OutReportFile As String
Dim InReportFile As String
InReportFile = "C:\Dynamics\App\HIST1"
Intyexcel.Workbooks.Open InReportFile & ".XLS"
Intyexcel.Sheets("Sheet2").Select
Intyexcel.Columns("A:Z").Select
Intyexcel.Selection.ClearContents
Intyexcel.Range("A1").Select
While rsADO.EOF <> True
With Intyexcel.Worksheets(2)
For c = 0 To Items
If rsADO(c) <> "" Then .Cells(r, c + 1).Value = rsADO(c)
Next c
r = r + 1
rsADO.MoveNext
End With
Wend
Intyexcel.Sheets("Sheet1").Select
' Intyexcel.ActiveSheet.PageSetup.Orientation = xlPortrait 'xlLandscape
' Intyexcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4
Intyexcel.ActiveSheet.PrintOut
Intyexcel.DisplayAlerts = False
Intyexcel.ActiveWorkbook.Save
OutReportFile = InReportFile & "_00" & MyMonth & MyDay
Intyexcel.ActiveWorkbook.SaveAs OutReportFile
Intyexcel.Quit
Intyexcel.DisplayAlerts = True
Set Intyexcel = Nothing
Set cnADO = Nothing
End Sub