WinCC中全局脚本VBS归档到Excel
WinCC中全局脚本VBS归档到Excel中
用一个变量触发数据归档到Excel中,请高手看看我写的为何不能运行。
Sub procedure1
If Item.OutputValue = "NewTag" Then
Dim oVar,oBlendingVar,objExcelApp,oWorkBook,ExcelTableFull,oFileName
On Error Resume Next
ExcelTableFull=0
Set objExcelApp=CreateObject("Excel.Application")
objExcelApp.Visible=False
Set oWorkBook=objExcelApp.Workbooks.Open("D:\BKHL_HXBJ\模板\Receipt_Table.xls") Dim iBlankLine
iBlankLine=oWorkBook.ActiveSheet.Columns(1).Find("0").Row
'MsgBox("iBlankLine="&iBlankLine)
If iBlankLine<504 Then
objExcelApp.Cells(iBlankLine,1).Value=HMIRuntime.SmartTags("Recipe_Number").Value objExcelApp.Cells(iBlankLine,2).Value=HMIRuntime.SmartTags("BaseOil_Percent_1").Value objExcelApp.Cells(iBlankLine,3).Value=HMIRuntime.SmartTags("BaseOil_Percent_2").Value objExcelApp.Cells(iBlankLine,4).Value=HMIRuntime.SmartTags("BaseOil_Percent_3").Value objExcelApp.Cells(iBlankLine,5).Value=HMIRuntime.SmartTags("BaseOil_Percent_4").Value objExcelApp.Cells(iBlankLine,6).Value=HMIRuntime.SmartTags("BaseOil_Percent_5").Value objExcelApp.Cells(iBlankLine,7).Value=HMIRuntime.SmartTags("BaseOil_Percent_6").Value objExcelApp.Cells(iBlankLine,8).Value=HMIRuntime.SmartTags("BaseOil_Percent_7").Value objExcelApp.Cells(iBlankLine,9).Value=HMIRuntime.SmartTags("BaseOil_Percent_8").Value objExcelApp.Cells(iBlankLine,10).Value=HMIRuntime.SmartTags("Additive_Percent_1").Value objExcelApp.Cells(iBlankLine,11).V alue=HMIRuntime.SmartTags("Additive_Percent_2").Value objExcelApp.Cells(iBlankLine,12).Value=HMIRuntime.SmartTags("Additive_Percent_3").Value objExcelApp.Cells(iBlankLine,13).Value=HMIRuntime.SmartTags("Additive_Percent_4").Value objExcelApp.Cells(iBlankLine,14).Value=HMIRuntime.SmartTags("Additive_Percent_5").Value objExcelApp.Cells(iBlankLine,15).Value=HMIRuntime.SmartTags("Additive_Percent_6").Value objExcelApp.Cells(iBlankLine,16).Value=HMIRuntime.SmartTags("Additive_Percent_7").Value objExcelApp.Cells(iBlankLine,17).Value=HMIRuntime.SmartTags("Additive_Percent_8").Value
Else
'MsgBox("Data Table Full,Copy to the backup file,continue ?")
objExcelApp.displayalerts=False
oFileName=CStr("D:\BKHL_HXBJ\模板\运行数据_"&Month(Date)&"月"&Day(Date)&"日"&"_"& Hour(Time)&"时"&Minute(Time)&"分"&".xls")
oWorkBook.Saveas(oFileName)
ExcelTableFull=1
objExcelApp.displayalerts=True
End If
oWorkBook.Save
objExcelApp.Workbooks.Close
objExcelApp.Quit
Set objExcelApp=Nothing
Set oWorkBook=Nothing
If ExcelTableFull=1 Then
'MsgBox("Data Table Full, Clear the current data table, continus?")
Set objExcelApp=CreateObject("Excel.Application")
objExcelApp.Visible=False
Set oWorkBook=objExcelApp.Workbooks.Open("D:\BKHL_HXBJ\模板\Receipt_Table_Templet.xls")
objExcelApp.displayalerts=False
oWorkBook.Saveas("D:\BKHL_HXBJ\模板\Receipt_Table.xls")
objExcelApp.displayalerts=True
oWorkBook.Save
objExcelApp.Workbooks.Close
objExcelApp.Quit
Set objExcelApp=Nothing
Set oWorkBook=Nothing
End If
End If
End Sub
本文转自亿万论坛:https://www.360docs.net/doc/c113460491.html,/a/a.asp?B=302&ID=1218853&q=1&r=140751