假设希望做这样一个报表界面，可以根据日期查询：

希望导出的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