WinCC7.5 将归档数据打印到MSFlexGrid控件

第一种方法：
WinCC7.5 将归档数据打印到MSHGrid控件
https://blog.csdn.net/weixin_37928884/article/details/134170305

第二种方法：
MSFlexGrid控件
查询按钮

Sub OnClick(ByVal Item)                                                                                                     
                                                                              
Dim myCatalog,myDS,PCName,cnstr,sqlstr1,sqlstr2
Dim grid,BTime,ETime,utcbtime,utcetime,utcbtstr,utcetstr
Dim conobj,rsobj1,comobj1
Dim rsobj2,comobj2
Dim rscount,i,curRow
myCatalog=HMIRuntime.Tags("@DatasourceNameRT").Read
PCName=HMIRuntime.Tags("@LocalMachineName").Read 
myDS=PCName & "\WinCC"
Set BTime=HMIRuntime.Tags("btime")
Set ETime=HMIRuntime.Tags("etime")
utcbtime=Dateadd("h",-8,BTime.Read) 
utcetime=Dateadd("h",-8,ETime.Read) 
utcbtstr = Year(utcbtime) & "-" & Month(utcbtime) & "-" & Day(utcbtime) & " " & Hour(utcbtime) & ":" & Minute(utcbtime) & ":" & Second(utcbtime)
utcetstr = Year(utcetime) & "-" & Month(utcetime) & "-" & Day(utcetime) & " " & Hour(utcetime) & ":" & Minute(utcetime) & ":" & Second(utcetime)
cnstr="Provider=WinCCOLEDBProvider.1; Catalog=" & myCatalog & "; Data Source=" &  myDS

'Msgbox cnstr

Set conobj=CreateObject("ADODB.Connection")
conobj.connectionstring=cnstr
conobj.CursorLocation = 3
conobj.Open
'TimeStep=2,1 表示间隔2秒。
'sqlstr = "Tag:R,('ProcessValueArchive\OFP';'ProcessValueArchive\OMP'),'" & utcbtstr & "','" & utcetstr & "'," & "'order by Timestamp ASC','TimeStep=1,1'"
sqlstr1 = "Tag:R,('ProcessValueArchive\OFP'),'" & utcbtstr & "','" & utcetstr & "'," & "'order by Timestamp ASC','TimeStep=1,1'"
sqlstr2 = "Tag:R,('ProcessValueArchive\OMP'),'" & utcbtstr & "','" & utcetstr & "'," & "'order by Timestamp ASC','TimeStep=1,1'"


Set rsobj1 = CreateObject("ADODB.Recordset")
Set comobj1 = CreateObject("ADODB.Command")
comobj1.CommandType = 1
Set comobj1.ActiveConnection = conobj
comobj1.CommandText = sqlstr1
Set rsobj1 = comobj1.Execute

Set rsobj2 = CreateObject("ADODB.Recordset")
Set comobj2 = CreateObject("ADODB.Command")
comobj2.CommandType = 1
Set comobj2.ActiveConnection = conobj
comobj2.CommandText = sqlstr2
Set rsobj2 = comobj2.Execute

Set grid=ScreenItems("grid")
rscount=rsobj1.RecordCount
If rscount=0 Then
 Msgbox "无记录"
 Exit Sub
End If
rsobj1.movefirst
rsobj2.movefirst


grid.Cols=4
grid.Rows=rscount+1

grid.TextMatrix(0,1)="日期时间"
grid.TextMatrix(0,2)="空气总压"
grid.TextMatrix(0,3)="煤气总压"


For i=1 To rscount
 curRow=i
 grid.TextMatrix(curRow,1)=Dateadd("h",+8,rsobj1.fields(1).value)
 grid.CellWidth(1)=2500
 grid.TextMatrix(curRow,2)=rsobj1.fields(2).value
 grid.TextMatrix(curRow,3)=rsobj2.fields(2).value
 rsobj1.movenext
 rsobj2.movenext
Next

Set rsobj1 = Nothing
Set rsobj2 = Nothing
conobj.Close
Set conobj = Nothing

End Sub

查询按钮

Sub OnClick(ByVal Item)                                                
                                                                                                     
                                                                              
Dim myCatalog,myDS,PCName,cnstr,sqlstr1,sqlstr2,sqlstr3,sqlstr4
Dim grid,utcbtime,utcetime,utcbtstr,utcetstr,begintime,endtime
Dim conobj
Dim rsobj1,comobj1
Dim rsobj2,comobj2
Dim rsobj3,comobj3
Dim rsobj4,comobj4

Dim rscount,i,curRow

myCatalog=HMIRuntime.Tags("@DatasourceNameRT").Read
PCName=HMIRuntime.Tags("@LocalMachineName").Read 
myDS=PCName & "\WinCC"

Set begintime=ScreenItems("BeginTime")
Set endtime=ScreenItems("EndTime")

utcbtime=Dateadd("h",-8,begintime.Value) 
utcetime=Dateadd("h",-8,endtime.Value) 
utcbtstr = Year(utcbtime) & "-" & Month(utcbtime) & "-" & Day(utcbtime) & " " & Hour(utcbtime) & ":" & Minute(utcbtime) & ":" & Second(utcbtime)
utcetstr = Year(utcetime) & "-" & Month(utcetime) & "-" & Day(utcetime) & " " & Hour(utcetime) & ":" & Minute(utcetime) & ":" & Second(utcetime)
cnstr="Provider=WinCCOLEDBProvider.1; Catalog=" & myCatalog & "; Data Source=" &  myDS

'Msgbox cnstr

Set conobj=CreateObject("ADODB.Connection")
conobj.connectionstring=cnstr
conobj.CursorLocation = 3
conobj.Open
'TimeStep=2,1 表示间隔2秒。
'sqlstr = "Tag:R,('ProcessValueArchive\MIXBP';'ProcessValueArchive\MIXBF'),'" & utcbtstr & "','" & utcetstr & "'," & "'order by Timestamp ASC','TimeStep=1,1'"
sqlstr1 = "Tag:R,('ProcessValueArchive\OMQ1S'),'" & utcbtstr & "','" & utcetstr & "'," & "'order by Timestamp ASC','TimeStep=1,1'"
sqlstr2 = "Tag:R,('ProcessValueArchive\OKQ1S'),'" & utcbtstr & "','" & utcetstr & "'," & "'order by Timestamp ASC','TimeStep=1,1'"
sqlstr3 = "Tag:R,('ProcessValueArchive\AUTO1'),'" & utcbtstr & "','" & utcetstr & "'," & "'order by Timestamp ASC','TimeStep=1,1'"
sqlstr4 = "Tag:R,('ProcessValueArchive\DQL1RS'),'" & utcbtstr & "','" & utcetstr & "'," & "'order by Timestamp ASC','TimeStep=1,1'"
'Msgbox "通过"

Set rsobj1 = CreateObject("ADODB.Recordset")
Set comobj1 = CreateObject("ADODB.Command")
comobj1.CommandType = 1
Set comobj1.ActiveConnection = conobj
comobj1.CommandText = sqlstr1
Set rsobj1 = comobj1.Execute


Set rsobj2 = CreateObject("ADODB.Recordset")
Set comobj2 = CreateObject("ADODB.Command")
comobj2.CommandType = 1
Set comobj2.ActiveConnection = conobj
comobj2.CommandText = sqlstr2
Set rsobj2 = comobj2.Execute

Set rsobj3 = CreateObject("ADODB.Recordset")
Set comobj3 = CreateObject("ADODB.Command")
comobj3.CommandType = 1
Set comobj3.ActiveConnection = conobj
comobj3.CommandText = sqlstr3
Set rsobj3 = comobj3.Execute


Set rsobj4 = CreateObject("ADODB.Recordset")
Set comobj4 = CreateObject("ADODB.Command")
comobj4.CommandType = 1
Set comobj4.ActiveConnection = conobj
comobj4.CommandText = sqlstr4
Set rsobj4 = comobj4.Execute


Set grid=ScreenItems("grid")
rscount=rsobj1.RecordCount
If rscount=0 Then
 Msgbox "无记录"
 Exit Sub
End If
rsobj1.movefirst
rsobj2.movefirst
rsobj3.movefirst
rsobj4.movefirst

grid.Cols=6
grid.Rows=rscount+1

grid.TextMatrix(0,1)="时间"
grid.TextMatrix(0,2)="M设定"
grid.TextMatrix(0,3)="K设定"
grid.TextMatrix(0,4)="自动"
grid.TextMatrix(0,5)="燃烧"

For i=1 To rscount
 curRow=i
 grid.TextMatrix(curRow,1)=Dateadd("h",+8,rsobj1.fields(1).value)
 grid.CellWidth(1)=2500
 grid.TextMatrix(curRow,2)=rsobj1.fields(2).value
 grid.TextMatrix(curRow,3)=rsobj2.fields(2).value
 grid.TextMatrix(curRow,4)=rsobj3.fields(2).value
 grid.TextMatrix(curRow,5)=rsobj4.fields(2).value
 
 rsobj1.movenext
 rsobj2.movenext
 rsobj3.movenext
 rsobj4.movenext
 
Next

Set rsobj1 = Nothing
Set rsobj2 = Nothing
Set rsobj3 = Nothing
Set rsobj4 = Nothing

conobj.Close
Set conobj = Nothing



End Sub

效果