本回答有11位钻石用户推荐

回答者：

zhangli0 - 超级顾问&nbsp&nbsp第15级

2019-07-25 16:40:06

''当前为按钮触发，

''创建一张当前日期命名的表格，如存在，跳过

Dim fso,myfile,daystr,dstr,fname

dstr=CStr(Year(Now))&"-"&CStr(Month(Now))&"-"&CStr(Day(Now))

fname="E:\报表\" + dstr + ".xls"

Set fso=CreateObject("scripting.FileSystemObject")

Set MyFile=fso.GetFile("E:\模板excel.xls")

If fso.FileExists(fname) Then

''MsgBox "文件已经存在"

''文件存在,不执行

else

MyFile.Copy(fname)   ''''不存在,复制模板

End If

''检测当前日期名表格是否打开，如有，关闭保存

''模板是否打开状态，无需检测(copy)

Dim objExcelApp,objExcelBook,objExcelSheet

On Error Resume Next

Dim ExcelApp,ExcelBook

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

If TypeName(ExcleApp) = "Application" Then

For Each ExcelBook In ExcelApp.WorkBooks

If ExcelBook.FullName ="E:\报表\" + dstr + ".xls" Then

ExcelApp.ActiveWorkbook.Save

ExcelApp.Workbooks.Close

ExcelApp.Quit

Set ExcelApp=Nothing

Exit For

End If

Next

End If

''定义变量

''Dim objExcelApp

Dim tagtag1,tagtag2,tagtag3,tagtag4,tagtag5,tagtag6,tagtag7,tagtag8,tagtag9,tagtag10,tagtag11,tagtag12,tagtag13

Dim i,j,xuhao

Dim tagshijian,sheetname

''REPORT1.NO1~NO13需要记录的数据

Set tagtag1=HMIRuntime.Tags("REPORT1.NO1")

Set tagtag2=HMIRuntime.Tags("REPORT1.NO2")

Set tagtag3=HMIRuntime.Tags("REPORT1.NO3")

Set tagtag4=HMIRuntime.Tags("REPORT1.NO4")

Set tagtag5=HMIRuntime.Tags("REPORT1.NO5")

Set xuhao=HMIRuntime.Tags("REPORT1_TR2")

sheetname="1#机当日批次报表"

''打开表格

Set objExcelApp =CreateObject("Excel.Application")

''open  file

objExcelApp.Visible=True

objExcelApp.Workbooks.Open"E:\报表\" + dstr + ".xls"

objExcelApp.Worksheets(sheetname).Activate

''实时数据写入

xuhao.Read

i=xuhao.Value+2

xuhao.Read

objExcelApp.Worksheets(sheetname).cells(i,1).value= xuhao.Value

tagshijian=CStr(Hour(Now))&":"&CStr(Minute(Now))&":"&CStr(Second(Now))

objExcelApp.Worksheets(sheetname).cells(i,2).value= tagshijian

tagtag1.Read

objExcelApp.Worksheets(sheetname).cells(i,3).value= tagtag1.Value

tagtag2.Read

objExcelApp.Worksheets(sheetname).cells(i,4).value= tagtag2.Value

tagtag3.Read

objExcelApp.Worksheets(sheetname).cells(i,5).value= tagtag3.Value

tagtag4.Read

objExcelApp.Worksheets(sheetname).cells(i,6).value= tagtag4.Value

tagtag5.Read

objExcelApp.Worksheets(sheetname).cells(i,7).value= tagtag5.Value

''关闭保存

objExcelApp.ActiveWorkbook.Save

objExcelApp.Workbooks.Close

objExcelApp.Quit

Set objExcelApp= Nothing

End Sub

本回答有17位钻石用户推荐

回答者：

泽诗冯冯 - 中级技术员&nbsp&nbsp第6级

2019-07-25 22:22:01

上一页

1

下一页