文章目录
1 环境
1 软件&环境需求
-
win10 OS
-
mysql 5.6~5.7
-
mysql ODBC connector
-
navicate
-
wincc 7.5 集成VBS
2 VBS脚本
2.1 wincc中集成Excel对象
Excel 对象的根对象是 Excel.application
excel.application->workbook->sheet->cell
' 在Wincc的起始画面的打开画面事件中写入下面脚本
' 创建 Excel Application并加入DataSet,以便在不同画面或画面窗口中访问。
Sub OnOpen()
Dim xlApp
Dim DSExist
Dim i
On Error Resume Next '出现错误继续执行
'检查 Excel 是否已运行,若无则新建应用,以防止重复运行 Exce
Set xlApp = GetObject("Excel Application")
If Typename(xlApp) <> "Application" Then
Set xlApp = CreateObject("Excel.Application")
End If
'检查 DataSet 中是否已有 xlApp,若无则添加
With HMIRuntime.DataSet
For i = 1 To .Count
If StrComp(.item(i).Name,"xlApp",1) = 0 Then
DSExist = 1
i = .Count
End If
Next
If DSExist = 0 Then .Add "xlApp",xlApp
End With
End Sub
2.2 链接数据库,并插入实时数据(ADODB)
2.2.1 测试代码
Option Explicit
Function action
On Error Resume Next
Dim conn, rs, com, sql
Dim water, power, medicine
Dim a
Dim b
a = Now
b = CStr(a)
water = HMIRuntime.Tags("report1.water").Read
power = HMIRuntime.Tags("report1.power").Read
medicine = HMIRuntime.Tags("report1.medicine").Read
Set conn = CreateObject("ADODB.Connection")
conn.ConnectionString = "Driver={MySQL ODBC 8.0 Unicode Driver};server=localhost;database=test;uid=root;pwd=root;option=3"
conn.CursorLocation = 3
conn.Open
'Msgbox conn.state
Set rs = CreateObject("ADODB.RecordSet")
'sql = "select * from report"
sql = "insert into report (addr, time, power, water, medicine) values(1,"&"'"& b & "'"& "," & power & "," & water & "," & medicine & ")"
'sql = "insert into report (addr, time, power, water, medicine) values(1,2,3,4,5)"
'Msgbox sql
'Msgbox sql
conn.Execute sql
'rs.Open sql,conn,1,3
'Msgbox (rs.state)
Set conn = Nothing
Set rs = Nothing
End Function
2.2.2 封装成函数
Sub insert(sql)
Dim conn
On Error Resume Next
Set conn = CreateObject("ADODB.connection")
With conn
.ConnectionString = "Driver={MySQL ODBC 8.0 Unicode Driver};server=localhost;database=test;uid=root;pwd=root;option=3"
.CursorLocation = 3
.Open
.Execute sql
End With
Set conn = Nothing
End Sub
2.2.3 动作中调用函数进行插入
Option Explicit
Function action
On Error Resume Next
Dim addr : addr = "PAC加药间I"
Dim medicine_A : medicineA = HMIRuntime.tags("FT0404_F.3_Feedback").Read/3600
Dim medicine_B : medicineA = HMIRuntime.tags("FT0405_F.3_Feedback").Read/3600
Dim medicine_total : medicine_total = medicine_A + medicine_B
Dim sql
sql = "insert into report (addr, time, power, water, medicine) " &_
"values(" &"'"& addr &"'" &","&"'"& CStr(Now) & "'"& "," & "Null" & "," & "Null" & "," & 1 & ")" &"," &_
"("&"'"&addr&"'"&","&"'"& CStr(Now) & "'"& "," & "Null" & "," & "Null" & "," & 1 & ")"
'Msgbox sql
insert(sql)
End Function
3 取出数据,填充excel,存储并展示
Sub OnLButtonDown(ByVal Item, ByVal Flags, ByVal x, ByVal y)
On Error Resume Next
Dim conn,rs,sql
Dim excel
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.RecordSet")
conn.ConnectionString = "Driver={MySQL ODBC 8.0 Unicode Driver};server=localhost;database=test;uid=root;pwd=root;option=3"
conn.CursorLocation = 3
conn.Open
'Msgbox (conn.State)
sql = "select addr, concat(Year(Time),'-',Month(Time),'-',Day(Time),' ',Hour(Time), ':00', ':00') As Time ,avg(power), avg(water), avg(medicine)" &_
"from report group by Year(Time), Month(Time), Day(Time), Hour(Time);"
'Msgbox sql
rs.Open sql,conn,1,3
'Msgbox(rs.State)
Dim m
m = rs.RecordCount
'Msgbox(m)
Dim xlApp, xlPath, xlFile, xlBook, xlSheet
Dim i,t
Dim objFSO, objFlexGrid, objProcessBar
Set objFSO = CreateObject("Scripting.FileSystemObject")
xlPath = HMIRuntime.ActiveProject.Path & "\Excel"
If Not objFSO.FolderExists(xlPath) Then
objFSO.CreateFolder(xlPath)
End If
Set objFSO = Nothing
Set xlApp = HMIRuntime.DataSet("xlApp").Value
Set xlBook = xlApp.Workbooks.Add
xlApp.Visible = False
Set xlSheet = xlBook.WorkSheets(1)
With xlSheet
.Activate
.Columns(1).ColumnWidth = 15
.Columns(2).ColumnWidth = 30
.Columns(3).ColumnWidth = 10
.Columns(4).ColumnWidth = 10
.Columns(5).ColumnWidth = 10
.Range("A:E").HorizontalAlignment = 3
.Range("A:E").Borders.LineStyle = 1
.Range("A1:E1").Interior.ColorIndex = 37
.Cells(1,1) = "工艺段"
.Cells(1,2) = "时间"
.Cells(1,3) = "电能消耗"
.Cells(1,4) = "水源消耗"
.Cells(1,5) = "药品消耗"
rs.MoveFirst
For i = 1 To m
.Cells(i+1, 1) = rs.Fields(0).Value
.Cells(i+1, 2) = rs.Fields(1).Value
.Cells(i+1, 3) = Round(rs.Fields(2).Value,1)
.Cells(i+1, 4) = Round(rs.Fields(3).Value,1)
.Cells(i+1, 5) = Round(rs.Fields(4).Value,1)
rs.MoveNext
Next
.Cells(m+2, 1) = "合计"
.Cells(m+2, 3) = "=SUM(C2:C"&m&")"
.Cells(m+2, 4) = "=SUM(D2:D"&m&")"
.Cells(m+2, 5) = "=SUM(E2:E"&m&")"
End With
t = Now
xlFile = Right("20"&Year(t),4)&"."&Right("0"&Month(t),2)&"."&Right("0"&Day(t),2)&"."&Right("0" & Hour(t),2)&"."&Right("0"&Minute(t),2)&"."&Right("0"&Second(t),2)&"."&"htm"
Msgbox(xlPath & xlFile)
xlBook.SaveAs xlPath&"\"&xlFile,44
xlApp.WorkBooks.Close
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Dim wbCtrl
Set wbCtrl = ScreenItems("控件1")
wbCtrl.MyPage = xlPath&"\"&xlFile
End Sub