WINCC历史报表（归档查询）实例

写在前面
好多学习和使用wincc的朋友（包括本人）都对历史报表很伤神，网上的贴子五花八门，能用的很少。能用的也只是一个简单的查出一个变量的例子。更有可恨的上传一些假的文档来骗我们新人手里那本来就可怜的积分。经过学习和摸索，终于做出了完整的例子，分享出来，希望对大家有帮助。
运行环境
软件： WINCC7.4 系统：Win7专业版64位
案例分享
例子是一个供暖的历史时刻数据，将查出的数据按要求显示在报表中，并能导入到EXCEL中。
界面代码
例子是在变量和归档都建好的条件下。

建立画面如下图

在画面的事件–>打开画面中添加如下代码（根据实际调整报表）

Dim msd,i
Set msd = ScreenItems("MSG")

msd.Visible = 0
With msd
	.Cols = 21
	.AllowUserResizing = True
	.ColWidth(0) = 2000
	.ColWidth(1) = 1000
	.ColWidth(2) = 1000
	.ColWidth(3) = 1000
	.ColWidth(4) = 1000
	.ColWidth(5) = 1000
	.ColWidth(6) = 1000
	.ColWidth(7) = 1000
	.ColWidth(8) = 1000
	.ColWidth(9) = 1000
	.ColWidth(10) = 1500
	.ColWidth(11) = 1000
	.ColWidth(12) = 1000
	.ColWidth(13) = 1500
	.ColWidth(14) = 1000
	.ColWidth(15) = 1000
	.ColWidth(16) = 1000
	.ColWidth(17) = 1000
	.ColWidth(18) = 1000
	.ColWidth(19) = 1500
	.ColWidth(20) = 1500

	.RowHeight(0) = 500
	.ColAlignmentFixed = 4
	.ColAlignment = 4
	.TextMatrix(0,0) = "站名"
	.TextMatrix(0,1) = "开阀面积"
	.TextMatrix(0,2) = "温度目标"
	.TextMatrix(0,3) = "二网供温"
	.TextMatrix(0,4) = "二网回温"
	.TextMatrix(0,5) = "二网供压"
	.TextMatrix(0,6) = "二网回压"
	
	.TextMatrix(0,7) = "一网供温"
	.TextMatrix(0,8) = "一网回温"
	.TextMatrix(0,9) = "一网流量"
	.TextMatrix(0,10) = "流量累计"
	.TextMatrix(0,11) = "一网热量"
	.TextMatrix(0,12) = "热 负 荷"
	.TextMatrix(0,13) = "热量累计"
	.TextMatrix(0,14) = "前日热量"
	.TextMatrix(0,15) = "一阀开度"
	.TextMatrix(0,16) = "二阀开度"
	
	.TextMatrix(0,17) = "水箱水位"
	.TextMatrix(0,18) = "循环频率"
	.TextMatrix(0,19) = "补水累计"
	.TextMatrix(0,20) = "电量累计"

End With

Dim Gcols,Grows
For Grows = 1 To msd.Rows - 1
	For Gcols = 0 To msd.Cols
		If 0 = Grows Mod 2 Then
			msd.Row = Grows
			msd.Col = Gcols
			msd.CellBackColor = RGb(233,235,245)
		Else
			msd.Row = Grows
			msd.Col = Gcols
			msd.CellBackColor = RGb(207,213,234)
		End If
	Next
Next
msd.Visible = 1

在查询按钮里写入如下代码（查询历史时刻数据并按要求格式写入MSHFGrid中）

Dim ed,et,de1,de2,de3
Set ed = ScreenItems("sDate")
Set et = ScreenItems("sTime")
de1 = DateValue(ed.Value) & " " & TimeValue(et.Value)
HMIRuntime.Tags("SDTime").Write de1
de2 = UTCA(de1)
de3 = Dateadd("n",1,de2)

Dim DSNName,m,i,k,ts,te,msd,wai
Dim sPro,sDsn,sSer,sCon
Dim conn,sSql,oRs,oCom

Set wai = ScreenItems("swait")
Set msd = ScreenItems("MSG")
DSNName = HMIRuntime.Tags("@DatasourceNameRT").Read
sPro = "Provider=WinCCOLEDBProvider.1;"
sDsn = "Catalog=" & DSNName & ";"
sSer = "Data Source=HS09\WinCC"
sCon = sPro + sDsn + sSer
Set conn = CreateObject("ADODB.Connection")
conn.ConnectionString = sCon
conn.CursorLocation = 3
conn.Open

msd.Visible = 0
wai.Visible = 1

For k = 6 To 11
	sSql = "Tag:R,('Nuit_" &k& "\TT24_" &k& "';'Nuit_" &k& "\TT21_" &k& "';'Nuit_" &k& "\TT22_" &k& "';"'
	sSql = sSql + "'Nuit_" &k& "\PT21_" &k& "';'Nuit_" &k& "\PT22_" &k& "';'Nuit_" &k& "\TT11_" &k& "';"
	sSql = sSql + "'Nuit_" &k& "\TT12_" &k& "';'Nuit_" &k& "\Flow11_" &k& "';'Nuit_" &k& "\Flow12_" &k& "';"
	sSql = sSql + "'Nuit_" &k& "\Heat11_" &k& "';'Nuit_" &k& "\Heat13_" &k& "';'Nuit_" &k& "\Heat12_" &k& "';"
	sSql = sSql + "'Nuit_" &k& "\Heat121_" &k& "';'Nuit_" &k& "\ECV102_" &k& "';'Nuit_" &k& "\ECV202_" &k& "';"
	sSql = sSql + "'Nuit_" &k& "\WLevel_" &k& "';'Nuit_" &k& "\CP21_" &k& "';'Nuit_" &k& "\Flow22_" &k& "';'Nuit_" &k& "\Elec12_" &k& "'),'" & de2 & "','" & de3 & "',TimeStep=60,1'"
	Set oRs = CreateObject("ADODB.Recordset")
	Set oCom = CreateObject("ADODB.Command")
		oCom.CommandType = 1
	Set oCom.ActiveConnection = conn
		oCom.CommandText = sSql
	Set oRs = oCom.Execute

	m = oRs.RecordCount
	
	If (m > 0) Then
		oRs.movefirst
		msd.TextMatrix(k-5,0) = HMIRuntime.Tags("un"&k).Read
		msd.TextMatrix(k-5,1) = HMIRuntime.Tags("Area12_"&k).Read
		For i = 1 To m		
			msd.TextMatrix(k-5,i+1) = Formatnumber(ors.fields(2).value,2,-1,,0)
			ors.movenext
			If oRs.Eof Then
				Exit For
			End If
		Next
		oRs.Close
		Set oRs = Nothing
	End If
Next

wai.Visible = 0
msd.Visible = 1
'Set oRs = Nothing
	conn.Close
Set conn = Nothing

加入排序代码，我用的是在MSHFGrid的双击里

Dim msd
Set msd = ScreenItems("MSG")
msd.Visible = 0
msd.Sort = 1 
Dim Gcols,Grows
For Grows = 1 To msd.Rows - 1
	For Gcols = 0 To msd.Cols
		If 0 = Grows Mod 2 Then
			msd.Row = Grows
			msd.Col = Gcols
			msd.CellBackColor = RGb(233,235,245)
		Else
			msd.Row = Grows
			msd.Col = Gcols
			msd.CellBackColor = RGb(207,213,234)
		End If
	Next
Next
msd.Visible = 1

导出至EXCEL代码

Dim msd,oex,spa
Dim i,m,k,st

Set msd = ScreenItems("MSG")

If "" = msd.TextMatrix(1,0) Then
	Msgbox "无导出内容！"
Else
	Set oex = CreateObject("Excel.Application")
	oex.Visible = False
	spa = HMIRuntime.ActiveProject.Path & "\moban.xlsx"
	oex.WorkBooks.open spa
	x = HMIRuntime.Tags("SDTime").Read
	st = "查询时间：" & x
	oex.Cells(2,1) = st
	m = msd.Rows
	For i = 0 To m-1
		For k = 0 To msd.Cols-1
			oex.Cells(i+3,k+1).Value = msd.TextMatrix(i,k)
		Next
	Next
	
	spa = sPath(x)
	oex.DisplayAlerts = False '对打开的文件，直接保存时，避免弹出对话框窗口，而是直接覆盖
	oex.activeworkbook.saveAs spa
	oex.workbooks.close
	oex.quit
	Set oex = Nothing
	Msgbox "成功导出至" & spa & "！"
End If

运行图片
在这里插入图片描述

在这里插入图片描述

缺点：查询速度慢。感觉是代码执行有问题，应该可以优化。本人能力有限。请路过的大神提点一下，加快查询速度，造福同行。

WINCC历史报表（归档查询）实例

猜你喜欢