搬家第一天-21.Wincc控件制作报表以及导出EXCEL方法介绍
假设希望做这样一个报表界面，可以根据日期查询：
希望导出的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
