Excel宏读取Wincc变量记录

利用Excel宏读取Wincc变量记录生成报表

Dim sPro, sDsn, sSer, sCon, sSql

Dim conn, oRs, oCom

Dim DSNName

Dim i As Integer

Dim sStart, sStop As String

Sub DTPFormat()

'日期控件显示格式

Sheet1.DTPicker1.Format = dtpCustom

Sheet1.DTPicker1.CustomFormat = "yyyy-MM-dd hh:mm"

Sheet1.DTPicker1.Value = Now()

Sheet1.DTPicker2.Format = dtpCustom

Sheet1.DTPicker2.CustomFormat = "yyyy-MM-dd hh:mm"

Sheet1.DTPicker2.Value = Now()

End Sub

Sub get_wincc_data()

'--Get Database DSN name-----------------------------------

Set DSNName = CreateObject("CCHMIRuntime.HMIRuntime")

sDsn = DSNName.Tags("@DatasourceNameRT").Read

'--build connection string-----------------------------------

sPro = "Provider=WinCCOLEDBProvider.1;"

sDsn = "Catalog=" & sDsn & ";"

sSer = "Data Source=.\WinCC"

sCon = sPro & sDsn & sSer

Set conn = CreateObject("ADODB.Connection")

conn.ConnectionString = sCon

conn.CursorLocation = 3

conn.Open

Set oRs = CreateObject("ADODB.Recordset")

Set oCom = CreateObject("https://www.360docs.net/doc/275791789.html,mand")

https://www.360docs.net/doc/275791789.html,mandType = 1

Set oCom.ActiveConnection = conn

'查询启止时间

sStart = Year(DTPicker1.Value) & "-" & Month(DTPicker1.Value) & "-" & Day(DTPicker1.Value) & " " & Hour(DTPicker1.V alue) & ":" & Minute(DTPicker1.Value) sStop = Year(DTPicker2.Value) & "-" & Month(DTPicker2.Value) & "-" & Day(DTPicker2.Value) & " " & Hour(DTPicker2.V alue) & ":" & Minute(DTPicker2.Value) '转为UTC时间

sStart = DateAdd("h", -8, CDate(sStart))

sStop = DateAdd("h", -8, CDate(sStop))

'读取Fan1_T1

sSql = "Tag:R,('ProcessValueArchive\start_flag'),'" & sStart & "','" & sStop & "' order by datetime"

https://www.360docs.net/doc/275791789.html,mandText = sSql

Set oRs = oCom.Execute

If (oRs.EOF) Then

oRs.Close

Else

oRs.MoveFirst

i = 0

Do While Not oRs.EOF

Dim start_time

start_time = DateAdd("h", 8, CDate(oRs.fields(1)))

Sheet1.Cells(i + 3, 2) = start_time

oRs.MoveNext

i = i + 1

Loop

oRs.Close

End If

'读取Fan1_T2

sSql = "Tag:R,('ProcessValueArchive\end_flag'),'" & sStart & "','" & sStop & "' order by datetime"

https://www.360docs.net/doc/275791789.html,mandText = sSql

Set oRs = oCom.Execute

If (oRs.EOF) Then

oRs.Close

Else

oRs.MoveFirst

i = 0

Do While Not oRs.EOF

Dim end_time

end_time = DateAdd("h", 8, CDate(oRs.fields(1)))

Sheet1.Cells(i + 3, 3) = end_time

oRs.MoveNext

i = i + 1

Loop

oRs.Close

End If

'读取Fan1_P1

sSql = "Tag:R,('ProcessValueArchive\reason_flag'),'" & sStart & "','" & sStop & "' order by datetime"

https://www.360docs.net/doc/275791789.html,mandText = sSql

Set oRs = oCom.Execute

If (oRs.EOF) Then

oRs.Close

Else

oRs.MoveFirst

i = 0

Do While Not oRs.EOF

Dim manjuan

manjuan = oRs.fields(2).Value

If manjuan = 20 Then

Sheet1.Cells(i + 3, 4) = "是"

Else

Sheet1.Cells(i + 3, 4) = "否"

End If

oRs.MoveNext

i = i + 1

Loop

oRs.Close

End If

'读取Fan1_P2

sSql = "Tag:R,('ProcessValueArchive\reason_flag'),'" & sStart & "','" & sStop & "' order by datetime"

https://www.360docs.net/doc/275791789.html,mandText = sSql

Set oRs = oCom.Execute

If (oRs.EOF) Then

oRs.Close

Else

oRs.MoveFirst

i = 0

Do While Not oRs.EOF

Dim manjuan_flag

manjuan_flag = oRs.fields(2).Value

If manjuan_flag = 10 Then

Sheet1.Cells(i + 3, 5) = "停车"

ElseIf manjuan_flag = 20 Then

Sheet1.Cells(i + 5, 5) = "自动切换"

ElseIf manjuan_flag = 30 Then

Sheet1.Cells(i + 3, 5) = "手动切换"

End If

oRs.MoveNext

i = i + 1

Loop

oRs.Close

End If

'读取Fan1_P1

sSql = "Tag:R,('ProcessValueArchive\all_counter'),'" & sStart & "','" & sStop & "' order by datetime"

https://www.360docs.net/doc/275791789.html,mandText = sSql

Set oRs = oCom.Execute

If (oRs.EOF) Then

oRs.Close

Else

oRs.MoveFirst

i = 0

Do While Not oRs.EOF

Sheet1.Cells(i + 3, 6) = oRs.fields(2).Value

oRs.MoveNext

i = i + 1

Loop

oRs.Close

End If

'读取Fan1_P1

sSql = "Tag:R,('ProcessValueArchive\ok_counter'),'" & sStart & "','" & sStop & "' order by datetime"

https://www.360docs.net/doc/275791789.html,mandText = sSql

Set oRs = oCom.Execute

If (oRs.EOF) Then

oRs.Close

Else

oRs.MoveFirst

i = 0

Do While Not oRs.EOF

Sheet1.Cells(i + 3, 7) = oRs.fields(2).Value

oRs.MoveNext

i = i + 1

Loop

oRs.Close

End If

Set oRs = Nothing

Set conn = Nothing

End Sub

Private Sub DTPicker1_Change()

clear_cell '清除已经填充的数据

get_wincc_data '读取WinCC历史数据

End Sub

Private Sub DTPicker2_Change()

clear_cell '清除已经填充的数据

get_wincc_data '读取WinCC历史数据

End Sub

Sub clear_cell()

For i = 3 To 100

For j = 1 To 10

Cells(i, j) = ""

Next j

Next i

End Sub