Wincc用VBS控制excel

Sub OnClick(Byval Item)

Dim fso,folder Dim type1

Dim patch,filename Dim

testposition,testnumber,startdate,printdate,brand,tyremodel,rim,tread,condition,load,speed,pressure,status

Set testposition=HMIRuntime.tags(\Set testnumber=HMIRuntime.tags(\Set startdate=HMIRuntime.tags(\Set printdate=HMIRuntime.tags(\Set brand=HMIRuntime.tags(\Set tyremodel=HMIRuntime.tags(\Set rim=HMIRuntime.tags(\Set tread=HMIRuntime.tags(\

Set condition=HMIRuntime.tags(\Set load=HMIRuntime.tags(\Set speed=HMIRuntime.tags(\

Set pressure=HMIRuntime.tags(\Set status=HMIRuntime.tags(\

'***********************check tyre type******************* tyremodel.Read

type1=tyremodel.Value If type1=\

MsgBox \ Exit Sub Else End If

'***********************check Report folder**************** Set fso=CreateObject(\If (fso.FolderExists(\Else

Set folder=fso.CreateFolder(\End If

'***********************close report************************* Dim objExcelApp,objExcelBook,objExcelSheet On Error Resume Next Dim ExcelApp,ExcelBook

Set ExcelApp = GetObject(,\If TypeName(ExcleApp) = \For Each ExcelBook In ExcelApp.WorkBooks

If ExcelBook.FullName = \ExcelApp.ActiveWorkbook.Save

ExcelApp.Workbooks.Close ExcelApp.Quit

Set ExcelApp= Nothing Exit For End If Next End If

'************************Report waiting massgae*************************** Dim waittingbit

Set waittingbit = HMIRuntime.Tags(\waittingbit.Read waittingbit.write 1

'************************creat connect report_2 archive******************** Dim sCon Dim sSql Dim conn Dim oRs Dim oCom Dim m,n Dim DSN

DSN = HMIRuntime.Tags(\sCon=\Security=SSPI;Persist Security Info=False;Data Source=.\\WINCC;Initial Catalog='\sSql = \

Set conn = CreateObject(\conn.ConnectionString = sCon conn.CursorLocation = 3 conn.Open

Set oRs = CreateObject(\Set oCom = CreateObject(\oCom.CommandType = 1

Set oCom.ActiveConnection = conn oCom.CommandText = sSql Set oRs = oCom.Execute m = oRs.Fields.Count

'************************* write datas to report.xls********************** Set objExcelApp =CreateObject(\objExcelApp.Visible=False

objExcelApp.Workbooks.Open\objExcelApp.Worksheets(ReportDatas).Activate '****************************report wating message*************************************************** Set waittingbit = HMIRuntime.Tags(\waittingbit.Read

waittingbit.write 1

'********************************************************************************

If (m > 0) Then oRs.MoveFirst n = 11

testposition.Read

objExcelApp.cells(5,3).value=testposition.value testnumber.Read

objExcelApp.cells(4,3).value=testnumber.value startdate.Read

objExcelApp.cells(6,3).value=startdate.value printdate=Now

objExcelApp.cells(7,3).value=printdate brand.Read

objExcelApp.cells(8,3).value=brand.value tyremodel.Read

objExcelApp.cells(9,3).value=tyremodel.value rim.Read

objExcelApp.cells(3,10).value=rim.value tread.Read

objExcelApp.cells(4,10).value=tread.value condition.Read

objExcelApp.cells(5,10).value=condition.value load.Read

objExcelApp.cells(6,10).value=load.value speed.read

objExcelApp.cells(7,10).value=speed.value pressure.Read

objExcelApp.cells(8,10).value=pressure.value status.Read

objExcelApp.cells(9,10).value=status.value

Do While Not oRs.EOF n = n + 1

objExcelApp.Cells(n,1).Value=oRs.Fields(1).Value objExcelApp.Cells(n,2).Value=oRs.Fields(2).Value objExcelApp.Cells(n,3).Value=oRs.Fields(3).Value objExcelApp.Cells(n,4).Value=oRs.Fields(4).Value objExcelApp.Cells(n,5).Value=oRs.Fields(5).Value objExcelApp.Cells(n,6).Value=oRs.Fields(6).Value objExcelApp.Cells(n,7).Value=oRs.Fields(7).Value objExcelApp.Cells(n,8).Value=oRs.Fields(8).Value objExcelApp.Cells(n,9).Value=oRs.Fields(9).Value

objExcelApp.Cells(n,10).Value=oRs.Fields(10).Value objExcelApp.Cells(n,11).Value=oRs.Fields(11).Value objExcelApp.Cells(n,12).Value=oRs.Fields(12).Value objExcelApp.Cells(n,13).Value=oRs.Fields(13).Value objExcelApp.Cells(n,14).Value=oRs.Fields(14).Value objExcelApp.Cells(n,15).Value=oRs.Fields(15).Value objExcelApp.Cells(n,16).Value=oRs.Fields(16).Value objExcelApp.Cells(n,17).Value=oRs.Fields(17).Value oRs.MoveNext Loop

filename=CStr(Year(Now))&\\ patch= \objExcelApp.ActiveWorkbook.SaveAs patch objExcelApp.Workbooks.Close objExcelApp.Quit

Set objExcelApp= Nothing End If oRs.Close

Set oRs = Nothing conn.Close

Set conn = Nothing

'**************************************close message************************* MsgBox \报表保存成功，路径：E:\\Report\\\Set waittingbit = HMIRuntime.Tags(\waittingbit.Read waittingbit.write 0

'***************************close save as report*********************************** End Sub