Private Sub Class_Terminate
me.CloseExcelFile
Set objWorkBook = Nothing
Set objSheet = nothing
Set oEngine =nothing
End Sub
'create a folder
Function Createreporterfolder(str_folderpath)
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
If not fso.FolderExists(str_folderpath) Then
Set f = fso.CreateFolder(str_folderpath)
Set f = Nothing
Set fso = Nothing
Else
Set fso = Nothing
End If
End Function作者: seagull1985 时间: 2011-8-16 11:54
'create a excelfile and initialize
Function CreateResultFile(FilePath)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If not fso.FileExists(FilePath)Then
Set oEngine = CreateObject("excel.Application")
'Disable alerts
oEngine.DisplayAlerts = False
'Add a workbook to the Excel App
oEngine.Workbooks.Add
'Get the object of the first sheet in the workbook
Set objSheet = oEngine.Sheets.Item(1)
oEngine.Sheets.Item(1).Select
With objSheet
'Rename the first sheet to "Test_Summery"
.Name = "Test_Summary"
'Set the Heading
.Range("B1").Value = "Test Results"
.Range("B1:C1").Merge
'Set color and Fonts for the Header
.Range("B1:C1").Interior.ColorIndex = 23
.Range("B1:C1").Font.ColorIndex = 2
.Range("B1:C1").Font.Bold = True
'Set the Date and time of Execution
.Range("B3").Value = "Test Date: "
.Range("B4").Value = "Test Start Time: "
.Range("B5").Value = "Test End Time: "
.Range("B6").Value = "Test Duration: "
.Range("C3").Value = Date
.Range("C4").Value = Time
.Range("C5").Value = Time
.Range("C6").Value = "=R[-1]C-R[-2]C"
.Range("C6").NumberFormat = "[h]:mm:ss;@"
'Set the Borders for the Date & Time Cells
.Range("B3:C8").Borders(1).LineStyle = 1
.Range("B3:C8").Borders(2).LineStyle = 1
.Range("B3:C8").Borders(3).LineStyle = 1
.Range("B3:C8").Borders(4).LineStyle = 1
'Format the Date and Time Cells
.Range("B3:C8").Interior.ColorIndex = 37
.Range("B3:C8").Font.ColorIndex = 1
.Range("B3:A8").Font.Bold = True
'Track the Row Count and insrtuct the viewer not to disturb this
.Range("C7").AddComment
.Range("C7").Comment.Visible = False
.Range("C7").Comment.Text "This is a very Important field for the script." & vbCrLf & "Please Do not Edit or Delete."
.Range("C7").Value = "0"
.Range("B7").Value = "Number Of Testcases:"
'Track the Testcase Count Count and insrtuct the viewer not to disturb this
.Range("C8").AddComment
.Range("C8").Comment.Visible = False
.Range("C8").Comment.Text "This is a very Important field for the script." & vbCrLf & "Please Do not Edit or Delete."
.Range("C8").Value = "0"
.Range("B8").Value = "Total Number Of Test Steps:"
.Range("B10").Value = "TestCase Name"
.Range("C10").Value = "Status"
.Range("D10").Value = "Number Of Steps"
.Range("E10").Value = "Pass"
.Range("F10").Value = "Fail"
.Range("G10").Value = "Warning"
.Range("H10").Value = "*Click the TestCase Name to see detail result."
'Format the Heading for the Result Summery
.Range("B10:G10").Interior.ColorIndex = 23
.Range("B10:G10").Font.ColorIndex = 2
.Range("B10:G10").Font.Bold = True
'Set the Borders for the Result Summery
.Range("B10:G10").Borders(1).LineStyle = 1
.Range("B10:G10").Borders(2).LineStyle = 1
.Range("B10:G10").Borders(3).LineStyle = 1
.Range("B10:G10").Borders(4).LineStyle = 1
.Range("B11").Select
End With
'Freez pane
oEngine.ActiveWindow.FreezePanes = True作者: seagull1985 时间: 2011-8-16 11:55
'Get the object of the first sheet in the workbook
Set objSheet = oEngine.Sheets.Item(2)
oEngine.Sheets.Item(1).Select
With objSheet
'Rename the first sheet to "Test_Result"
.Name = "Test_Result"
'Set the Heading for the Result Columns
.Range("A1").Value = "STEP NAME"
.Range("B1").Value = "STATUS"
.Range("C1").Value = "EXPECTED RESULT"
.Range("D1").Value = "ACTUAL RESULT"
.Range("E1").Value = "ERROR MESSAGE"
'Format the Heading for the Result Columns
.Range("A1:E1").Interior.ColorIndex = 23
.Range("A1:E1").Font.ColorIndex = 2
.Range("A1:E1").Font.Bold = True
'Set the Borders for the Result Header
.Range("A1:E1").Borders(1).LineStyle = 1
.Range("A1:E1").Borders(2).LineStyle = 1
.Range("A1:E1").Borders(3).LineStyle = 1
.Range("A1:E1").Borders(4).LineStyle = 1
' .Range("A2").Select
End With
'Freez pane
oEngine.ActiveWindow.FreezePanes = True
'Save the Workbook at the specified Path with the Specified Name
oEngine.ActiveWorkbook.saveas FilePath
oEngine.Workbooks.close
oEngine.quit
'Relese the Object
Set objSheet = Nothing
End If
Set fso = Nothing
End Function
'openExcelfile
Function OpenExcelFile(Excelpath)
Set oEngine = CreateObject("Excel.Application")
Set objWorkBook = oEngine.Workbooks.Open(Excelpath)
end Function
Function CloseExcelFile()
oEngine.ActiveWorkbook.save
oEngine.Workbooks.close
oEngine.quit
End Function
Function StartReportEngine(str_foldername,str_filename)
Createreporterfolder(str_ScriptPath&str_foldername)
CreateResultFile(str_ScriptPath&str_foldername&"\"&str_filename)
End Function作者: seagull1985 时间: 2011-8-16 11:56
Public Sub Report (sStatus, sStepName,sExpected,sActual, sDetails)
'Open the Result file
' Set objWorkBook = oEngine.Workbooks.Open (oSettings("File"))
'Select the Summery Sheet
Set objSheet = oEngine.Sheets("Test_Summary")
oEngine.Sheets("Test_Summary").Select
With objSheet
'Note the Row No. on which to Report the result
Row = .Range("C8").Value + 2*.Range("C7").Value + 2
TCRow = .Range("C7").Value + 11
NewTC = False
.Range("F" & TCRow).Font.ColorIndex = 3
.Range("E" & TCRow).Font.ColorIndex = 50
.Range("G" & TCRow).Font.ColorIndex = 46
'Check if it is a new Tetstcase
If objSheet.Cells(TCRow - 1, 2).Value <> TestcaseName Then
.Cells(TCRow, 2).Value = TestcaseName
oEngine.ActiveSheet.Hyperlinks.Add objSheet.Cells(TCRow, 2), "", "Test_Result!A" & Row+1, TestcaseName
.Cells(TCRow, 3).Value = sStatus
.Range("F" & TCRow).Value = "0"
.Range("E" & TCRow).Value = "0"
.Range("G" & TCRow).Value = "0"
Select Case sStatus
Case "Fail"
.Range("C" & TCRow).Font.ColorIndex = 3
.Range("F" & TCRow).Value = "1"
Case "Pass"
.Range("C" & TCRow).Font.ColorIndex = 50
.Range("E" & TCRow).Value = "1"
Case "Warning"
.Range("C" & TCRow).Font.ColorIndex = 46
.Range("G" & TCRow).Value = "1"
End Select
'The first step.
.Cells(TCRow, 4).Value = 1 '(D,11)
NewTC = True
'it is a new Testcase
.Range("C7").Value = .Range("C7").Value + 1 'count the cases.
'Set the Borders for the Result Header
.Range("B" & TCRow & ":G" & TCRow).Borders(1).LineStyle = 1
.Range("B" & TCRow & ":G" & TCRow).Borders(2).LineStyle = 1
.Range("B" & TCRow & ":G" & TCRow).Borders(3).LineStyle = 1
.Range("B" & TCRow & ":G" & TCRow).Borders(4).LineStyle = 1
'Set color and Fonts for the Header
.Range("B" & TCRow & ":G" & TCRow).Interior.ColorIndex = 2
.Range("B" & TCRow).Font.ColorIndex = 23
.Range("B" & TCRow & ":G" & TCRow).Font.Bold = True
'====NOT A NEW CASE================================================================
Else
.Range("D" & TCRow-1).Value = .Range("D" & TCRow-1).Value + 1
Select Case sStatus
Case "Fail"
.Range("F" & TCRow-1).Value = .Range("F" & TCRow-1).Value +1
Case "Pass"
.Range("E" & TCRow-1).Value = .Range("E" & TCRow-1).Value +1
Case "Warning"
.Range("G" & TCRow-1).Value = .Range("G" & TCRow-1).Value +1
End Select
End If
If (Not NewTC) And (sStatus = "Fail") Then
.Cells(TCRow-1, 3).Value = "Fail"
.Range("C" & TCRow-1).Font.ColorIndex = 3
End If
If (Not NewTC) And (sStatus = "Warning") Then
If .Cells(TCRow-1, 3).Value = "Pass" Then
.Cells(TCRow-1, 3).Value = "Warning"
.Range("C" & TCRow-1).Font.ColorIndex = 46
End If
End If作者: seagull1985 时间: 2011-8-16 11:57
.Range("C8").Value = .Range("C8").Value + 1
'Update the End Time
.Range("C5").Value = Time
'Set Column width
.Columns("B").Select
.Columns("B").Autofit
End With
'Select the Result Sheet
Set objSheet = oEngine.Sheets("Test_Result")
oEngine.Sheets("Test_Result").Select
With objSheet
'Enter the Result
If NewTC Then
.Range("A" & Row & ":E" & Row).Interior.ColorIndex = 37
.Range("A" & Row & ":E" & Row).Merge
Row = Row + 1
.Range("A" & Row & ":E" & Row).Merge
.Range("A" & Row).Value = TestcaseName
'Set color and Fonts for the Header
.Range("A" & Row & ":E" & Row).Interior.ColorIndex = 2
.Range("A" & Row & ":E" & Row).Font.ColorIndex = 23
.Range("A" & Row & ":E" & Row).Font.Bold = True
Row = Row + 1
End If
.Range("A" & Row).Value = sStepName
'oEngine.Selection.ShapeRange.ScaleWidth 1.72, msoFalse, msoScaleFromTopLeft
'oEngine.Selection.ShapeRange.ScaleHeight 1.81, msoFalse, msoScaleFromTopLeft
End With
oEngine.Sheets("Test_Summary").Select
oEngine.Sheets("Test_Summary").Range("B1").Select
'Save the Workbook
objWorkBook.Save
End Sub
End Class
Set oReporterManager = new excelreporterengine作者: zeng0848 时间: 2012-1-30 17:20
好东西，顶起作者: hinaeddie 时间: 2012-10-15 14:53
請問 Error Message 要如何取得？sDetails 怎麼來的？作者: louqqson008 时间: 2012-10-15 15:36
看着头晕啊
").ColumnWidth = 35
ass"