假設希望做這樣一個報表界面，可以根據日期查詢：
希望導出的excel報表文件在C盤根目錄，是這個樣子：
接下來我們一步步實現這個功能。
1. Wincc歷史趨勢的數據庫表結構有點不好理解，我們新建一個數據庫名字叫做Report，新建一張表，結構是這個樣子：
注意開放sa用戶，設置sa用戶有管理report數據庫權限，使用sql登陸模式。
2. 我們每5秒往report表寫入一條記錄，在全局VBS腳本寫入如下代碼：
Option Explicit
Function action
'添加紀錄
Dim T1,T2,P1,P2,F1,F2,L1,L2,A1,A2,S1,S2
Dim ors,conn,con,ssql,ocom
Dim PCName
PCName=hmiruntime.Tags("@LocalMachineName").Read
T1=HMIRuntime.Tags("溫度1").Read
T2=HMIRuntime.Tags("溫度2").Read
P1=HMIRuntime.Tags("壓力1").Read
P2=HMIRuntime.Tags("壓力2").Read
F1=HMIRuntime.Tags("流量1").Read
F2=HMIRuntime.Tags("流量2").Read
L1=HMIRuntime.Tags("液位1").Read
L2=HMIRuntime.Tags("液位2").Read
A1=HMIRuntime.Tags("分析儀1").Read
A2=HMIRuntime.Tags("分析儀2").Read
S1=HMIRuntime.Tags("轉速1").Read
S2=HMIRuntime.Tags("轉速2").Read
con="Provider = SQLOLEDB.1;password = sa;user id = sa;Initial Catalog =Report;Data Source = " & PCName & "\WINCC"
Set conn=CreateObject("ADODB.Connection")
conn.ConnectionString=con
conn.Cursorlocation=3
conn.open
ssql="insert into Report(CurDateTime,T1,T2,P1,P2,F1,F2,L1,L2,A1,A2,S1,S2) values(Getdate()," _
& T1 & "," & T2 & "," & P1 & "," & P2 & "," & F1 & "," & F2 & "," & L1 & "," & L2 & "," & A1 & "," & A2 & "," & S1 & "," & S2 & ")"
Set ors=CreateObject("ADODB.RecordSet")
Set ocom=CreateObject("ADODB.Command")
Set ocom.activeconnection=conn
ocom.CommandType=1
ocom.CommandText=ssql
Set ors=ocom.Execute
Set ors=Nothing
conn.close
Set conn=Nothing
End Function
腳本中的函數不做解釋。
3. WINCC頁面Report中添加ActiveX控件Microsoft Data and Time Picker Control 6.0(SP4) 、Microsoft Hierarchical FlexGrid Control Version 6.0(OLEDB)、Microsoft ProgressBar Control 6.0(SP4)以及按鈕、靜態文本等控件。這控件需要右鍵點擊ACTIVEX控件-添加才會出現在控件列表，如果提示需要注冊，安裝一下VB6即可。添加后Microsoft Data and Time Picker Control 6.0(SP4)控件修改為DTPicker，Microsoft Hierarchical FlexGrid Control Version 6.0(OLEDB)控件名字修改為HFGrid，Microsoft ProgressBar Control 6.0(SP4)名字修改為Progress，默認不顯示。
4. 查詢按鈕鼠標點擊事件VBS腳本為：
Sub OnClick(ByVal Item)
Dim sdate
Dim conn
Dim ssql
Dim ors
Dim ocom
Dim scon
Dim DBGrid
Dim ADODC
Dim syear
Dim smonth
Dim sday
Dim PCName
PCName=HMIRuntime.Tags("@LocalMachineName").Read
syear=CStr(Year(ScreenItems("DTPicker").value))
If Month(ScreenItems("DTPicker").value)<10 Then
smonth= "0" & CStr(Month(ScreenItems("DTPicker").value))
Else
smonth=CStr(Month(ScreenItems("DTPicker").value))
End If
If Day(ScreenItems("DTPicker").value)<10 Then
sday= "0" & CStr(Day(ScreenItems("DTPicker").value))
Else
sday=CStr(Day(ScreenItems("DTPicker").value))
End If
sdate=syear & "/" & smonth & "/" & sday
scon="Provider = SQLOLEDB.1;Integrated Security=SSPI;Persist SecurityInfo=False;Initial Catalog =Report;Data Source = " &PCName & "\WINCC"
ssql="select CurDateTime as '日期時間',T1 as '溫度1',T2 as '溫度2',P1 as '壓力1',P2 as '壓力2', F1 as '流量1'," _
& "F2 as '流量2', L1 as '液位1',L2 as '液位2',A1 as '分析儀1',A2 as '分析儀2',S1 as '轉速1',S2 as '轉速2' from Report " _
& "where convert(char(10),CurDateTime,111)= '" & sdate & "'"
Set conn=CreateObject("ADODB.Connection")
conn.ConnectionString=scon
conn.Cursorlocation=3
conn.open
Set ors=CreateObject("ADODB.RecordSet")
Set ocom=CreateObject("ADODB.Command")
ocom.commandtype=1
Set ocom.ActiveConnection=conn
ocom.CommandText=ssql
Set ors=ocom.Execute
Set DBGrid=ScreenItems("HFGrid")
Set DBGrid.DataSource=ors
DBGrid.Refresh
ScreenItems("HFGrid").colwidth(1)=2500
Set ors=Nothing
conn.close
Set conn=Nothing
End Sub
5. 導出到Excel按鈕的鼠標點擊事件VBS腳本為：
Sub OnClick(ByVal Item)
Dim i,j,k,m,n,filename
Dim xlapp
Dim HFGrid
Dim ors
If ScreenItems("HFGrid").rows>1 Then
ScreenItems("progress").value =0
ScreenItems("progress").visible = True
Set xlapp=CreateObject("Excel.Application")
xlapp.visible=False
xlapp.workbooks.add
For k=1 To ScreenItems("HFgrid").cols-1
xlapp.worksheets(1).cells(3,k)=ScreenItems("HFGrid").TextMatrix(0,k)
Next
xlapp.worksheets(1).cells(1,1)="XX裝置生產工藝參數報表"
m=ScreenItems("HFGrid").rows
For i=1 To m-1
For j= 1 To ScreenItems("HFGrid").cols-1
xlapp.worksheets(1).cells(i+3,j)=ScreenItems("HFGrid").TextMatrix(i,j)
Next
ScreenItems("progress").value =i*100/m
'ScreenItems("HFGrid").recordset.movenext
Next
'以下代碼處理日期時間數據格式以及表格邊框線、標題合並單元格等排版
xlapp.worksheets(1).range("a1:m1").mergecells=True
xlapp.worksheets(1).range("a4:a" & CStr(2+ScreenItems("HFGrid").rows)).NumberFormat="yyyy/mm/dd hh:mm:ss"
xlapp.worksheets(1).range("a1").ColumnWidth =20
xlapp.worksheets(1).cells(2,1)="生成時間："
xlapp.worksheets(1).cells(2,2)=Year(Now) & "年" & Month(Now) & "月" & Day(Now) & "日"
xlapp.worksheets(1).cells(1,1).HorizontalAlignment = 3
xlapp.worksheets(1).range("a3:m" & CStr(2+ScreenItems("HFGrid").rows)).borders(1).linestyle=9
xlapp.worksheets(1).range("a3:m" & CStr(2+ScreenItems("HFGrid").rows)).borders(1).weight=2
xlapp.worksheets(1).range("a3:m" & CStr(2+ScreenItems("HFGrid").rows)).borders(2).linestyle=9
xlapp.worksheets(1).range("a3:m" & CStr(2+ScreenItems("HFGrid").rows)).borders(2).weight=2
xlapp.worksheets(1).range("a3:m" & CStr(2+ScreenItems("HFGrid").rows)).borders(3).linestyle=9
xlapp.worksheets(1).range("a3:m" & CStr(2+ScreenItems("HFGrid").rows)).borders(3).weight=2
xlapp.worksheets(1).range("a3:m" & CStr(2+ScreenItems("HFGrid").rows)).borders(4).linestyle=9
xlapp.worksheets(1).range("a3:m" & CStr(2+ScreenItems("HFGrid").rows)).borders(4).weight=2
filename= "c:\" & Year(Now) & "年" & Month(Now) & "月" & Day(Now) & "日-" & Hour(Now) & "點" & Minute(Now) & "分" & Second(Now) & "秒生成生產報表.xlsx"
xlapp.Activeworkbook.saveas (filename)
xlapp.workbooks.close
xlapp.quit
ScreenItems("progress").Visible =False
Msgbox "成功導出到C:\"
End If
End Sub