WinCC中全局脚本VBS归档到Excel中

已锁定

撇尤

  • 帖子

    14
  • 精华

    0
  • 被关注

    4

论坛等级:游民

注册时间:2004-11-22

普通 普通 如何晋级?

WinCC中全局脚本VBS归档到Excel中

1159

4

2012-10-12 09:32:03

用一个变量触发数据归档到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).Value=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
WinCC中全局脚本VBS归档到Excel中 已锁定
编辑推荐: 关闭

请填写推广理由:

本版热门话题

SIMATIC WinCC / Panel

共有32767条技术帖

相关推荐

热门标签

相关帖子推荐

guzhang

恭喜,你发布的帖子

评为精华帖!

快扫描右侧二维码晒一晒吧!

再发帖或跟帖交流2条,就能晋升VIP啦!开启更多专属权限!

  • 分享

  • 只看
    楼主

top
X 图片
您收到0封站内信:
×
×
信息提示
很抱歉!您所访问的页面不存在,或网址发生了变化,请稍后再试。