Dim oReporterManager
Set oReporterManager = New ReportManager
Call oReporterManager.StartReport("人人围登录1","C:\Report.xls","测试下而已1","sirrah1")
Call oReporterManager.Report("Pass","Test_Case1","成功","成功","步骤详细1")
Call oReporterManager.StartReport("人人围登录2","C:\Report.xls","测试下而已2","sirrah2")
Call oReporterManager.Report("Fail","Test_Case2","成功","成功","步骤详细2")
Class ReportManager
Dim Str_CaseName '测试用例名
Dim Str_FileName '报告存放地址
Dim Str_CaseDesc '测试用例描述
Dim Str_Author '测试用例编写者
Dim bln_Init '是否初始化
'-------------------------------------------------------------------------------
'
' 函数名称: StartReport
' 函数说明: 开启生成测试报告机制
' 参数说明:
' (1).sReportType:报告类型(目前仅支持Excel、Html)
' (2).sCaseName:测试用例名称
' (3).sFileName:报告输出的路径(文件在磁盘绝对路径位置)
' (4).sCaseDesc:测试用例描述、说明
' (5).sAuthor:测试用例设计者名称
' 返回结果: 无
' 调用方法:
' StartReport("Html","TestLogin","C:\Report.html","TestLoginDesc","Sirrah")
'
'-------------------------------------------------------------------------------
Function StartReport(sCaseName,sFileName,sCaseDesc,sAuthor)
'检查sFileName文件格式是否是合法的Excle文件格式
If Not CheckFile(sFileName) Then
ReportEvent "","","对不起!您输入的文件:"&sFileName&"是不合法的Excle文件格式!"
End If
'判断当前格式的报告是否存在,如果存在则删除该文件
If IsFileExist(sFileName)And Not bln_Init Then
DeleteFile(sFileName)
CreateReport(sFileName)
bln_Init = True
End If
Str_CaseName = sCaseName
Str_FileName = sFileName
Str_CaseDesc = sCaseDesc
Str_Author = sAuthor
End Function
Function CreateReport(Str_FileName)
' Set fso = CreateObject("scripting.FileSystemObject")
' Str_Folder=Left(Str_FileName,InStrRev(Str_FileName,"\")-1)
' If Not fso.FolderExists(Str_Folder) Then
' FSO.CreateFolder(Str_Folder)
' End If
' Set fso = Nothing
Set oExcel=CreateObject("Excel.Application")
oExcel.Visible=false
oExcel.DisplayAlerts = False
oExcel.Workbooks.Add
'设置第一个sheet样式
Set oSheet = oExcel.Sheets.Item(1)
oExcel.Sheets.Item(1).Select
With oSheet
.Name = "测试概要" '将第一个sheet命名为"测试概要"
.Range("B1").Value = "测试结果" '设置顶部第一行标题
.Range("B1:E1").Merge 'B1到C1合并居中
.Range("B1:E1").Interior.ColorIndex = 21 '单元格背景颜色
.Range("B1:E1").HorizontalAlignment = 3 '对齐方式:居中
.Range("B1:E1").Font.ColorIndex = 19 '设置字体的颜色
.Range("B1:E1").Font.Bold = True '设置字体加粗
.Range("B1:E1").Font.Size = 16 '设置字体的大小
'设置测试概要信息内容
.Range("B3").Value = "测试日期: "
.Range("D3").Value = "测试开始时间: "
.Range("B4").Value = "测试用时: "
.Range("D4").Value = "测试结束时间: "
.Range("B5").Value = "总用例数:"
.Range("D5").Value = "总步骤数:"
.Range("B6").Value = "成功用例数:"
.Range("D6").Value = "失败用例数:"
.Range("C3").Value = Date()
.Range("E3").Value = Time()
.Range("E3").NumberFormat = "hh:mm:ss" '设置时间的格式为24小时制
.Range("E4").Value = Time()
.Range("E4").NumberFormat = "hh:mm:ss"'设置时间的格式为24小时制
.Range("C4").Value = "=RC[2]-R[-1]C[2]" '结束时间减去开始时间
.Range("C4").NumberFormat = "hh:mm:ss"
.Range("C5").Value = "0"
.Range("E5").Value = "0"
.Range("C6").Value = "0"
.Range("E6").Value = "0"
'设置单元格四周边框
.Range("B3:E6").Borders(1).LineStyle = 1
.Range("B3:E6").Borders(2).LineStyle = 1
.Range("B3:E6").Borders(3).LineStyle = 1
.Range("B3:E6").Borders(4).LineStyle = 1
'设置背景色和字体样式
.Range("B3:E6").Font.Bold = True
.Range("B3:E6").Font.Size = 10
.Range("B3:B6").Interior.ColorIndex = 50
.Range("B3:B6").Font.ColorIndex = 19
.Range("D3:D6").Interior.ColorIndex = 50
.Range("D3:D6").Font.ColorIndex = 19
.Range("C3:C6").Interior.ColorIndex = 15
.Range("C3:C6").HorizontalAlignment = 3
.Range("C3:C5").Font.ColorIndex = 25
.Range("C6:C6").Font.ColorIndex = 10
.Range("E3:E6").Interior.ColorIndex = 15
.Range("E3:E6").HorizontalAlignment = 3
.Range("E3:E5").Font.ColorIndex = 25
.Range("E6:E6").Font.ColorIndex = 3
'设置测试用例区域标题
.Range("B10").Value = "用例名"
.Range("C10").Value = "测试结果"
.Range("D10").Value = "用例步骤数"
.Range("E10").Value = "用例描述"
.Range("F10").Value = "设计者"
.Range("G11").Value = "*点击用例名查看详细的测试结果"
'设置背景色和字体样式
.Range("B10:F10").Interior.ColorIndex = 21
.Range("B10:F10").HorizontalAlignment = 3
.Range("B10:F10").Font.ColorIndex = 19
.Range("B10:F10").Font.Bold = True
.Range("B10:F10").Font.Size = 14
'设置单元格四周边框
.Range("B10:F10").Borders(1).LineStyle = 1
.Range("B10:F10").Borders(2).LineStyle = 1
.Range("B10:F10").Borders(3).LineStyle = 1
.Range("B10:F10").Borders(4).LineStyle = 1
'设置单元格自动适应大小
.Columns("B:F").Autofit
.Range("B11").Select
oExcel.ActiveWindow.FreezePanes = True
End With
'设置第二个sheet样式
Set oSheet = oExcel.Sheets.Item(2)
oExcel.Sheets.Item(2).Select
With oSheet
.Name = "测试结果" ''将第二个sheet命名为"测试结果"
'标题栏每列的宽度
.Columns("B:B").ColumnWidth = 20
.Columns("C:C").ColumnWidth = 15
.Columns("D:D").ColumnWidth = 25
.Columns("E:E").ColumnWidth = 25
.Columns("F:F").ColumnWidth = 25
.Columns("B:F").HorizontalAlignment = 2 '对齐方式左对齐
.Columns("B:F").WrapText = True
'设置标题栏名称
.Range("B1").Value = "步骤名"
.Range("C1").Value = "测试结果"
.Range("D1").Value = "预期结果"
.Range("E1").Value = "实际结果"
.Range("F1").Value = "结果描述"
'设置标题栏字体样式
.Range("B1:F1").Interior.ColorIndex = 21
.Range("B1:F1").Font.ColorIndex = 19
.Range("B1:F1").Font.Bold = True
.Range("B1:F1").Font.Size = 16
'设置单元格四周边框
.Range("B1:F1").Borders(1).LineStyle = 1
.Range("B1:F1").Borders(2).LineStyle = 1
.Range("B1:F1").Borders(3).LineStyle = 1
.Range("B1:F1").Borders(4).LineStyle = 1
.Range("B2").Select
oExcel.ActiveWindow.FreezePanes = True
End With
'删除多余的第三个sheet
Set oSheet = oExcel.Sheets.Item(3)
oExcel.Sheets.Item(3).delete
oExcel.Sheets.Item(1).Select
oExcel.ActiveWorkbook.saveas Str_FileName
oExcel.Quit
Set oSheet=Nothing
Set oExcel=Nothing
End Function
'-------------------------------------------------------------------------------
'
' 函数名称: Report
' 函数说明: 向报告中输入每个检查点结果
' 参数说明:
' (1).sStatus:报告类型(目前仅支持Excel、Html)
' (2).sStepName:测试用例名称
' (3).sExpected:报告输出的路径(文件在磁盘绝对路径位置)
' (4).sActual:测试用例描述、说明
' (5).sDetails:测试用例设计者名称
' 返回结果: 无
' 调用方法:
' Report("Pass","Test_Case1","成功","成功","步骤详细")
'
'-------------------------------------------------------------------------------
Function Report(sStatus,sStepName,sExpected,sActual,sDetails)
Dim oWorkBook
Dim oSheet
Dim Row, TCRow, NewTC
Set oExcel=CreateObject("Excel.Application")
Set oWorkBook = oExcel.Workbooks.Open (Str_FileName)
Set oSheet = oExcel.Sheets("测试概要")
oExcel.Sheets("测试概要").Select
With oSheet
Row = .Range("E5").Value + 2*.Range("C5").Value + 2 '获取当前测试步骤行
TCRow = .Range("C5").Value + 11
NewTC = False
'Check if it is a new Tetstcase
If oSheet.Cells(TCRow - 1, 2).Value <> Str_CaseName Then
.Cells(TCRow, 2).Value = Str_CaseName
oExcel.ActiveSheet.Hyperlinks.Add oSheet.Cells(TCRow, 2), "", "测试结果!B" & Row+1, Str_CaseName
.Cells(TCRow, 3).Value = sStatus
.Cells(TCRow, 5).Value = Str_CaseDesc
.Cells(TCRow, 6).Value = Str_Author
Select Case sStatus
Case "Fail"
.Range("E6").Value=.Range("E6").Value+1
.Range("C" & TCRow).Font.ColorIndex = 3
Case "Pass"
.Range("C6").Value=.Range("C6").Value+1
.Range("C" & TCRow).Font.ColorIndex = 10
End Select
.Cells(TCRow, 4).Value = 1
NewTC = True
.Range("C5").Value = .Range("C5").Value + 1
'Set the Borders for the Result Header
.Range("B" & TCRow & ":F" & TCRow).Borders(1).LineStyle = 1
.Range("B" & TCRow & ":F" & TCRow).Borders(2).LineStyle = 1
.Range("B" & TCRow & ":F" & TCRow).Borders(3).LineStyle = 1
.Range("B" & TCRow & ":F" & TCRow).Borders(4).LineStyle = 1
'Set color and Fonts for the Header
.Range("B" & TCRow & ":F" & TCRow).Interior.ColorIndex = 19
.Range("B" & TCRow & ":D" & TCRow).HorizontalAlignment = 3
.Range("F" & TCRow & ":F" & TCRow).HorizontalAlignment = 3
.Range("B" & TCRow).Font.ColorIndex = 53
.Range("B" & TCRow & ":F" & TCRow).Font.Bold = True
.Range("B" & TCRow & ":F" & TCRow).Font.Size=10
.Range("B" & TCRow & ":F" & TCRow).WrapText = True
.Range("E" & TCRow).Font.ColorIndex=23
Else
.Range("D" & TCRow-1).Value = .Range("D" & TCRow-1).Value + 1
End If
If (Not NewTC) And .Cells(TCRow-1, 3).Value="Pass" And(sStatus = "Fail") Then
.Range("E6").Value=.Range("E6").Value+1
.Range("C6").Value=.Range("C6").Value-1
.Cells(TCRow-1, 3).Value = "Fail"
.Range("C" & TCRow-1).Font.ColorIndex = 3
End If
.Range("E5").Value = .Range("E5").Value + 1
'Update the End Time
.Range("E4").Value = Time()
'Set Column width
.Columns("B:E").Autofit
End With
'Select the Result Sheet
Set oSheet = oExcel.Sheets("测试结果")
oExcel.Sheets("测试结果").Select
With oSheet
'Enter the Result
If NewTC Then
.Range("B" & Row & ":F" & Row).Interior.ColorIndex = 2
.Range("B" & Row & ":F" & Row).Merge
Row = Row + 1
.Range("B" & Row & ":F" & Row).Merge
.Range("B" & Row).Value ="测试用例名:"&VbTab&Str_CaseName
'Set color and Fonts for the Header
.Range("B" & Row & ":F" & Row).Interior.ColorIndex = 47
.Range("B" & Row & ":F" & Row).Font.ColorIndex = 19
.Range("B" & Row & ":F" & Row).Font.Bold = True
.Range("B" & Row & ":F" & Row).Font.Size = 14
Row = Row + 1
End If
.Range("B" & Row).Value = sStepName
.Range("C" & Row).Value = sStatus
.Range("C" & Row).Font.Bold = True
Select Case sStatus
Case "Pass"
.Range("C" & Row).Font.ColorIndex = 10
Case "Fail"
.Range("B" & Row & ":F" & Row).Font.ColorIndex = 3
End Select
.Range("C" & Row).Font.Bold = True
.Range("D" & Row).Value = sExpected
.Range("E" & Row).Value = sActual
.Range("F" & Row).Value = sDetails
'Set the Borders
.Range("B" & Row & ":F" & Row).Borders(1).LineStyle = 1
.Range("B" & Row & ":F" & Row).Borders(2).LineStyle = 1
.Range("B" & Row & ":F" & Row).Borders(3).LineStyle = 1
.Range("B" & Row & ":F" & Row).Borders(4).LineStyle = 1
.Range("B" & Row & ":F" & Row).VerticalAlignment = -4160
.Range("B" & Row & ":F" & Row).Font.Size = 10
End With
oExcel.Sheets("测试概要").Select
oWorkBook.Save
oExcel.Quit
Set oSheet=Nothing
Set oExcel=Nothing
Set oWorkBook = Nothing
End Function
'-------------------------------------------------------------------------------
'
' 函数名称: CheckFile
' 函数说明: 检查文件格式是否符合报告支持的格式
' 参数说明:
' (1).sFileName:报告类型(目前仅支持Excel、Html)
' 返回结果: boolean,是否是合法的文件格式
' 调用方法:
' CheckFile("c:\Test.Html")
'
'-------------------------------------------------------------------------------
Function CheckFile(sFileName)
'sSuffix 获取文件的后缀名
sSuffix=Right(sFileName,Len(sFileName)-InStrRev(sFileName,"."))
If LCase(sSuffix) = "xls" Or LCase(sSuffix) = "xlsx" Then
CheckFile = True
End If
End Function
'-------------------------------------------------------------------------------
'
' 函数名称: ReportEvent
' 函数说明: 输出报告信息
' 参数说明:
' (1).bln_Status:报告类型(目前仅支持Excel、Html)
' (2).obj_Type:报告类型(目前仅支持Excel、Html)
' (3).str_Text:报告类型(目前仅支持Excel、Html)
' 返回结果: 无
' 调用方法:
' ReportEvent "","","对不起!您输入的文件:"&sFileName&"是不合法的Excle文件格式!"
'
'-------------------------------------------------------------------------------
Function ReportEvent(bln_Status,obj_Type,str_Text)
'Reporter.Filter = rtEnableAll
'Reporter.ReportEvent status, objtype, text
'DetailLogPrint objtype&":"&VBTab&text&"【"& status &"】"
'Reporter.Filter = rfDisableAll
'MsgBox str_Text
End Function
'-------------------------------------------------------------------------------
'
' 函数名称: IsFileExist
' 函数说明: 检查文件是否存在
' 参数说明:
' (1).sFile:文件路径
' 返回结果: boolean,文件夹是否存在
' 调用方法:
' CheckFile("c:\Test.Html")
'
'-------------------------------------------------------------------------------
Function IsFileExist(sFile)
Set fso = CreateObject("scripting.FileSystemObject")
IsFileExist = fso.FileExists(sFile)
End Function
'-------------------------------------------------------------------------------
'
' 函数名称: DeleteFile
' 函数说明: 删除文件
' 参数说明:
' (1).sFile:文件路径
' 返回结果: 无
' 调用方法:
' DeleteFile("c:\Test.Html")
'
'-------------------------------------------------------------------------------
Function DeleteFile(sFile)
Set fso = CreateObject("scripting.FileSystemObject")
fso.DeleteFile(sFile)
End Function
End Class