WinCC中全局脚本VBS归档到Excel

WinCC中全局脚本VBS归档到Excel
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

相关主题
相关文档
最新文档