VBS wincc报表模板批量生产

Excel批量模板生成文件

用于WINCC报表生成。

dim i,j,m

Dim fso

On Error Resume Next

‘**************************************************生成目录

set fso=createobject("scripting.filesystemobject")

if fso.FolderExists("F:\报表") then '判断生成目录为报表生成做准备如果存在什么都不干else

Set objFolder=fso.CreateFolder("F:\报表")'如果不存在则生成它（下面的一样）

end if

if fso.FolderExists("F:\报表\日报") then

else

Set objFolder=fso.CreateFolder("F:\报表\日报")

end if

for m=1 to 12

if fso.FolderExists("F:\报表\日报\"&m&"月") then

else

Set objFolder=fso.CreateFolder("F:\报表\日报\"&m&"月")

end if

next

Set fso = Nothing

'**************************************************生成目录

On Error Resume Next

set fso1=createobject("scripting.filesystemobject")

Filename="F:\Repot.xls" '模板提取

'**************************************************生成保存文件

Set oExcel= CreateObject("Excel.Application")

Set oWb = oExcel.Workbooks.Open(Filename) '打开Filenames的文件

Set fso1 = CreateObject("Scripting.FileSystemObject")

for i=1 to 12 '12个月

for j=1 to 31 '每个月算31天

patch="F:\报表\日报\"&i&"月\"&Year(Now )&"年"&i&"月"&j&"日.xls" '组建地址

If fso1.FileExists(patch) Then '判断文件是否存在如果存在什么都不干

else oExcel.ActiveWorkBook.SaveAs( patch ) '假如不存在则另存为（地址）

end if

next

next

'**************************************************生成保存文件

Set fso1 = Nothing

oExcel.WorkBooks.Close

oExcel.Quit

Set oExcel = Nothing

On Error Resume Next

'********************************************结束进程

Sub CloseProcess(sProcessName)

For each Process inGetObject("winmgmts:{impersonation Level=impersonate}").Instances

Of("Win32_process") '利用wimp遍历所有进程

If Process. Name = sProcessName Then '判断进程名称

Process. terminate '关闭指定进程

End If

Next

End Sub

'********************************************结束进程

CloseProcess "EXCEL.EXE"

'********************************************结束EXCEL

VBS Excel写入数据用于WINCC与EXCEL 报表生成，用动作定时产生。配合上面程序让wincc报表变得简单。

Dim oExcel,oWb,oSheet,HK

'********************************************地址组建

Dim Patch,filename,fso,MyFile,Filenames

Set fso = CreateObject("Scripting.FileSystemObject")

filename=Year(Now )&"年"&Month(Now)&"月"&Day(x)&"日" & Hour(Now)&"时"'&Minute(Now) &"分"'&Second(Now)&"秒"'时间

patch="F:\"&filename&".xls" '模板提取

'********************************************地址组建

'********************************************判断是否存在

If fso.FileExists(patch) Then

Filenames=patch

HK=1

Else Filenames="F:\Repot.xls":HK=0

END IF

'********************************************判断是否存在

'********************************************定义对象

Set oExcel= CreateObject("Excel.Application")

Set oWb = oExcel.Workbooks.Open(Filenames) '打开Filenames的文件Set oSheet = oWb.Sheets("Sheet1") '激活表1

'********************************************数据操作区

with oExcel

'D0=oExcel.Cells(7,1).Value

'D0=oExcel.Cells(7,2).Value

.Cells(7,3).Value = "坛洛镇T"

.Cells(7,4).Value = "坛洛镇T"

.Cells(7,5).Value = "坛洛镇T"

.Cells(8,3).Value = "坛洛镇T"

.Cells(8,4).Value = "坛洛镇T"

.Cells(8,5).Value = "坛洛镇T"

.Cells(9,3).Value = "坛洛镇T"

.Cells(9,4).Value = "坛洛镇T"

.Cells(9,5).Value = "坛洛镇T"

'oExcel.Visible=TRUE'不显示 False

end with

'********************************************判断保存

if HK=1 then

oExcel.ActiveWorkbook.Save'保存参数

else oExcel.ActiveWorkBook.SaveAs( patch ) '另存为（地址）

end if

'********************************************判断保存

'********************************************退出关闭

oExcel.WorkBooks.Close

oExcel.Quit