【seagull1985-QTP】EXCEL测试报告生成一
代码的来源已经不记得哪里COPY的了，我自己用了觉得非常好，优化了里面部分的代码。大家有兴趣的可以试试。。先上2张效果图代码部分因为超过贴子长度要求，只能分开2个贴子放出来了，使用的时候，直接把2份代码接起来就可以了
代码PART1
Class excelreporterengine
Private oEngine
Private objSheet
Private objWorkBook
Public str_ScriptPath
Private Sub Class_Initialize
str_ScriptPath = str_Test_Path&"Report\"
me.StartReportEngine GetTestName,"Result.xls"
me.OpenExcelFileme.str_ScriptPath&GetTestName&"\"&"Result.xls"
End Sub
Private Sub Class_Terminate
me.CloseExcelFile
Set objWorkBook = Nothing
Set objSheet = nothing
SetoEngine =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
'create a excelfileand initialize
Function CreateResultFile(FilePath)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If notfso.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 = ":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
'Set Column width
.Columns("B:G").Select
.Columns("B:G").Autofit
.Range("B11").Select
End With
'Freez pane
oEngine.ActiveWindow.FreezePanes = True
'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 Column widths
.Columns("A:A").ColumnWidth = 30
.Columns("B:B").ColumnWidth = 15
.Columns("C:D").ColumnWidth = 35
.Columns("E:E").ColumnWidth = 35
.Columns("A:E").HorizontalAlignment = -4131
.Columns("A:E").WrapText = True
'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
我的运行到179行的时候会提示报错这是什么原因 绿色的枫叶 发表于 2016-9-26 15:07
我的运行到179行的时候会提示报错这是什么原因
图中提示的错误，有没有排除下？ seagull1985 发表于 2016-9-26 16:22
图中提示的错误，有没有排除下？
排除过，文件下都已创建表格了，但是创建的表格里只有表头和格式 其他内容都没有 多谢
页:
[1]
