WINCC歷史報表（歸檔查詢）例項
阿新 • • 發佈：2019-01-01
- 寫在前面
好多學習和使用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
執行圖片
缺點：查詢速度慢。 感覺是程式碼執行有問題，應該可以優化。本人能力有限。請路過的大神提點一下，加快查詢速度，造福同行。