Option Explicit
Function action

Dim objExcelApp,objExcelBook,objExcelsheet
Dim tagchaya1_w,tagchaya2_w,tagchaya3_w,tagchaya4_w,s
Dim tagchaya5_w,tagchaya6_w,tagchaya7_w,g
Dim sheetname,l,c,tagshijian
Dim patch,filename
sheetname="sheetdemo"
'此处为归档变量名
Set tagchaya1_w=HMIRuntime.Tags("1#电炉顶除尘差压1")
Set tagchaya2_w=HMIRuntime.Tags("1#电炉顶除尘差压2")
Set tagchaya3_w=HMIRuntime.Tags("1期电炉烟罩除尘差压")
Set tagchaya4_w=HMIRuntime.Tags("1#aod1#除尘压差")
Set tagchaya5_w=HMIRuntime.Tags("1#aod2#除尘压差")
Set tagchaya6_w=HMIRuntime.Tags("2#aod1#除尘压差")
Set tagchaya7_w=HMIRuntime.Tags("2#aod2#除尘压差")
Set s=HMIRuntime.Tags("hs")
Set g=HMIRuntime.Tags("m1207")



On Error Resume Next
If s.Value>=3 And s.Value<=38And g.Value=1Then
Dim ExcelApp,ExceleBook
Set ExcelApp=GetObject(,"Excel.Application")

If TypeName(ExcelApp)="Application" Then
For Each ExcelBook In ExcelApp.WorkBooks
If ExcelBook.FullName="D:\cc1.xlsx" Then

Exit For
End If
Next
End If

Set objExcelApp=GetObject(,"Excel.Application")

objExcelApp.Visible=False
objExcelApp.Worksheets(sheetname).Activate



Set objExcelApp=CreateObject("Excel.Application")
objExcelApp.Workbooks.Open"D:\ccl.xlsx"
objExcelApp.Visible=False
objExcelApp.Worksheets(sheetname).Activate
With objExcelApp.Worksheets(sheetname)

For l=3 To 38
For c=1 To 9
.cells(l,c).value=Null
Next
Next
End With


filename=CStr(Year(Now))&CStr(Month(Now))&CStr(Day(Now))
tagshijian=CStr(Hour(Now))&":"&CStr(Minute(Now))&":"&CStr(Second(Now))
objExcelApp.Worksheets(sheetname).cells(s.Value,2).value=tagshijian
tagchaya1_w.Read
objExcelApp.Worksheets(sheetname).cells(s.Value,3).value=tagchaya1_w.Value
tagchaya2_w.Read
objExcelApp.Worksheets(sheetname).cells(s.Value,4).value=tagchaya2_w.Value
tagchaya3_w.Read
objExcelApp.Worksheets(sheetname).cells(s.Value,5).value=tagchaya3_w.Value
tagchaya4_w.Read
objExcelApp.Worksheets(sheetname).cells(s.Value,6).value=tagchaya4_w.Value
tagchaya5_w.Read
objExcelApp.Worksheets(sheetname).cells(s.Value,7).value=tagchaya5_w.Value
tagchaya6_w.Read
objExcelApp.Worksheets(sheetname).cells(s.Value,8).value=tagchaya6_w.Value
tagchaya7_w.Read
objExcelApp.Worksheets(sheetname).cells(s.Value,8).value=tagchaya7_w.Value

If s.Value=38 Then

objExcelApp.Worksheets(sheetname).cells(41,9).value=filename.Value
patch="E:\report\1\"&filename&"1期除尘报表.xlsx"
objExcelApp.ActiveWorkbook.SaveAs patch
objExcelApp.ActiveWorkbook. patch protect
objExcelApp.Workbooks.Close
objExcelApp.Quit
Set objExcelApp=Nothing
Else
objExcelApp.ActiveWorkbook.SaveAs "D:\cc1.xlsx"
objExcelApp.Workbooks.Close
objExcelApp.Quit



'End with

End If

'MsgBox "数据存"



'MsgBox "文件已另存"

End If

End Function