使用Excel连接WINCC生成报表的实现方法

WINCC自带的报表功能,在工程应用上不太适合国人的风格,所以就想借用强大的excel表格功能来制作灵活多变的丰富的报表。使用Excel的VBA功能实现和WINCC的变量建立连接,实现数据查询,可实现实时数据历史数据库查询,将获得的数据生成报表。效果如下图在这里插入图片描述

打开excel的代码编辑,并在workbook模块下建立如下代码:

创建变量:

Public sStart, sStop, I1, I2, I3, U12, U23, U13, P, Q, PF, EPimp, EQimp, username, WPName, pds
Dim sPro
Dim sDsn
Dim sSer
Dim sCon
Dim sSql
Dim conn
Dim oRs
Dim oCom
Dim DSNName
Dim i
Dim j
Dim k
Dim arrStart(0 To 63)
Dim arrStop(0 To 63)
Dim arrValue(0 To 63)
Public Tmp_time, CTime1, CTime2

获取WINCC中相应变量的名称,后续程序中需要使用的变量:

Public Sub get_date()
Set tagname1 = CreateObject("CCHMIRuntime.HMIRuntime")
username = tagname1.Tags("@CurrentUser").Read
I1 = tagname1.Tags("Tag_RP_I1").Read
I2 = tagname1.Tags("Tag_RP_I2").Read
I3 = tagname1.Tags("Tag_RP_I3").Read
U12 = tagname1.Tags("Tag_RP_U12").Read
U23 = tagname1.Tags("Tag_RP_U23").Read
U13 = tagname1.Tags("Tag_RP_U13").Read
P = tagname1.Tags("Tag_RP_P").Read
Q = tagname1.Tags("Tag_RP_Q").Read
PF = tagname1.Tags("Tag_RP_PF").Read
EPimp = tagname1.Tags("Tag_RP_EPimp").Read
EQimp = tagname1.Tags("Tag_RP_EQimp").Read
sStart = tagname1.Tags("sStartTime").Read
sStop = tagname1.Tags("sStopTime").Read
WPName = tagname1.Tags("WPName").Read
pds = tagname1.Tags("WPName_pds").Read

End Sub

创建数据库连接:

 Sub DataConnect()
'--------------------创建连接----------------------------------------
On Error GoTo myerr
Set DSNName = CreateObject("CCHMIRuntime.HMIRuntime")
sDsn = DSNName.Tags("@DatasourceNameRT").Read
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("ADODB.Command")
oCom.CommandType = 1
Set oCom.activeconnection = conn
sSql = "Tag:R,('" & I1 & "'),'0000-00-00 00:00:00.000','0000-00-00 01:00:00.000'"
oCom.CommandText = sSql
Set oRs = oCom.Execute
n = oRs.RecordCount
If (n > 0) Then
    oRs.movefirst
     Tmp_time = oRs.fields("TimeStamp").Value
    oRs.Close
Else
End If
Exit Sub
myerr: MsgBox "数据库连接错误!"
End Sub

查询wincc历史数据库中的数据,并将查询到的数据填充表格,主要代码如下:

Sub GetDataTotal()
On Error GoTo myerror
sSql = "Tag:R,('" & I1 & "'),'" & sStart & "','" & sStop & "','timestep =3600,258'"
oCom.CommandText = sSql
Set oRs = oCom.Execute
n = oRs.RecordCount
If (n > 0) Then
    oRs.movefirst
    b = 0
    Do While Not oRs.EOF
     Worksheets("Sheet1").Cells(b + 5, 2) = oRs.fields("RealValue").Value
    oRs.movenext
    b = b + 1
    Loop
    oRs.Close
Else
MsgBox "查无数据!"
End If
'B相电流
sSql = "Tag:R,('" & I2 & "'),'" & sStart & "','" & sStop & "','timestep =3600,258'"
oCom.CommandText = sSql
Set oRs = oCom.Execute
n = oRs.RecordCount
If (n > 0) Then
    oRs.movefirst
    b = 0
    Do While Not oRs.EOF
    Worksheets("Sheet1").Cells(b + 5, 3) = oRs.fields("RealValue").Value
    oRs.movenext
    b = b + 1
    Loop
    oRs.Close
Else
MsgBox "查无数据!"
End If

......

Exit Sub
myerror: MsgBox "错误,请输入正确的时间!"
End Sub

表头生成:

Sub FillDataTotal()
Cells(1, 1).Value = WPName & "   日报表"
Cells(2, 12).Value = sStop
Cells(31, 13).Value = username
If pds = "高压配电所" Then
 Cells(3, 13).Value = "有功电度(MWh)"
 Cells(3, 14).Value = "无功电度(Mvarh)"
 Cells(29, 6).Value = "(MWh)"
 Cells(29, 12).Value = "(Mvarh)"
 Else
  Cells(3, 13).Value = "有功电度(KWh)"
 Cells(3, 14).Value = "无功电度(Kvarh)"
 Cells(29, 6).Value = "(KWh)"
 Cells(29, 12).Value = "(Kvarh)"
 End If
End Sub

清空表格:

Sub cleartable()
Dim i, j
For i = 5 To 28
    For j = 2 To 4
    Worksheets("Sheet1").Cells(i, j).Value = 0
    Next
 Next
  For i = 5 To 28
    For j = 6 To 8
     Worksheets("Sheet1").Cells(i, j).Value = 0
    Next
 Next
  For i = 5 To 28
    For j = 10 To 14
     Worksheets("Sheet1").Cells(i, j).Value = Null
    Next
    Next
End Sub

保护excel表,防止生成的报表数据被篡改:

Public Sub ProtectAllSheets()
Dim n As Integer
For n = 1 To Worksheets.Count
Worksheets(n).Protect Password:="EHSJDFLjkhshdkduk2735649ex", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
Next
End Sub

解锁excel:

Public Sub UnprotectAllSheets()
Dim n As Integer
For n = 1 To Worksheets.Count
Worksheets(n).Unprotect Password:="EHSJDFLjkhshdkduk2735649ex"
Next
End Sub

主程序:获取wincc中的变量名,解锁excel,清空,并创建wincc历史数据库的连接,弹出需要查询的日期,选择完日期后,按日期查询数据,计算,填表。

Private Sub Workbook_Open()
Dim year1, year2
Dim month1, month2
Dim day1, day2
get_date         '获取日期,获取出表人
UnprotectAllSheets   '解锁Excel保护
cleartable
DataConnect      '创建数据库连接
'如果选择的时间超出数据库存储的时间,结束查询。
CTime1 = CDate(sStop)
CTime2 = CDate(Tmp_time)
year1 = Year(CTime1)
year2 = Year(CTime2)
month1 = Month(CTime1)
month2 = Month(CTime2)
day1 = Day(CTime1)
day2 = Day(CTime2)
If (year2 > year1) Then
MsgBox "时间选择错误,请重选时间!"
GoTo timeerr
Else
    If (year2 = year1) Then
        If (month2 > month1) Then
        MsgBox "时间选择错误,请重选时间!"
        GoTo timeerr
        Else
            If (month2 = month1) Then
                If (day2 > day1) Then
                MsgBox "时间选择错误,请重选时间!"
                GoTo timeerr
                Else
                End If
            End If
        End If
    End If
End If
GetDataTotal     '获取电度总计
FillDataTotal    '填写电度总计数据
ProtectAllSheets     '保护Excel内容
Exit Sub
timeerr:
ProtectAllSheets     '保护Excel内容

End Sub

源代码:https://download.csdn.net/download/lujiakai113/21048335

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

C bug专业户

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值