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
tengzejun508
- 浏览: 26035 次
- 性别:
- 来自: 上海
-
最新评论
分享到：
发表评论
-
vbs class的调用及字典的应用代码
2014-03-17 12:07 607<!--StartFragment -->Cla ... -
QTP中利用DOM实现拖动浏览器滚动条
2014-01-10 16:48 523QTP中利用DOM实现拖动浏览器滚动条 有的时候需要在 ... -
QTP11使用DOM XPath以及CSS识别元素对象
2013-12-23 15:54 811我们知道，像DOM，Html,CSS,XPath等对对象的 ... -
QTP之有关富文本框赋值
2013-10-21 17:35 1157前段时间在做QTP脚本时，遇到一个问题，主要问题是给富文本框 ... -
QTP如何检查WEB对象是否隐藏
2013-10-10 10:38 568在WEB页面中隐藏对象的3种方式1、使用display例如： ... -
QTP登录案例
2013-09-22 18:20 827SystemUtil.Run "http://1 ... -
判断datatable中的数据是否有重复数据
2013-09-13 12:06 1525rowcount= DataTable.GetSheet(&q ... -
QTP测试报告代码
2013-09-09 12:59 788自动化测试实际是将测 ... -
京东网：疯狂抢购、猜您喜欢等模块下的图片超链接自动化测试
2013-09-02 17:30 512SystemUtil.Run "http://ww ... -
测试自动化实现难点—Web对象的识别
2013-08-30 13:25 675静态Web对象的识别 序号 ... -
京东网京东快报超级链接验证
2013-08-30 12:37 986SystemUtil.Run "http://www ... -
获取背景颜色
2013-08-27 15:02 744Browser("ITeye Java编程 Spr ... -
Dictionary 字典对象
2013-08-23 11:32 832... -
Scripting.Dictionary对象
2013-08-23 11:08 1350[vb] view plaincopy ... -
测试自动化设计 - GUI层面向对象的扩展设计
2013-08-23 10:48 612测试自动化设计 - GUI层面向对象的扩展设计 ... -
对WebElement对象使用编程性描述
2013-08-08 18:18 2277对WebElement对象使用编程性描述（Using Pro ... -
vbs中get和set方法
2013-08-07 13:23 934Class User Private s_name ... -
TO&RO
2013-08-02 15:17 7631．GetTOProperty() ● 基本含义：获取 ... -
QTP关闭多余的browser窗口
2013-08-02 14:23 509要判断打开了几个浏览器窗口，我们使用description对 ... -
QTP如何打开浏览器，并进入网站,关闭浏览器
2013-08-02 14:10 1541简单记录下打开浏览器的方法 '打开IE，进入系统----- ...
相关推荐
qtp制造EXCEL报表，一段VBS生成报告的代码。
QTP实现两个Excel表格数据对比代码，Function导入，直接调用该Function就可实现数据对比
qtp代码框架------一位高手的杰作,里面是根据EXCEL文件进行读取参数，并把结果写入EXCEL参数，其中还包括参数的验证
QTP实现自动读取excel测试用例的数据及保存实际结果并用正则表达式进行匹配实例
用QTP实现EXCEL数据比对
关键字框架是在数据驱动的基础上，把测试脚本提取成关键字，保存到数据库或者Excel中，然后框架从数据文件中读取出关键字信息，qtp来执行的一种框架，本文介绍该框架，并对关键文件进行分析介绍。
这是一个现在比较普遍的，也是QTP里面对框架初步认识的一个轻量级自动化框架模型，大家可以做个参考
qtp轻量级框架，有测试脚本、说明文档ppt，是学习qtp框架思想的好资料
对整套QTP自动化都有详细的步骤描述以及测试层次，是一份不可多得的好资料
QTP测试框架（含源码），一高手写的，可以自己修改，做成您想要的，只要您有基础，不是问题
轻量级的自动化框架，展示了QTP搭建自动化框架的步骤，注意事项，已经如何运行
QTP中文手册+自动测试框架+saffron QTP中文手册+自动测试框架+saffron
QTP中Excel比较，代码详情，可以实现数据对比和显示对比结果
qtp 访问sql server数据库及操作excel
用VBscritp在QTP的基础上进行二次开发，是自动化测试更加简洁高效。其中包含所有源代码和文档。
1、UFT三种自动化测试框架 2、第一种纯VBS脚本导入就可以用 3、第二种是工具集合excel用 3、第三种也是工具，主要针对的是web类的自动化
用QTP实现EXCEL数据比对 了解QTP调用excel的方式和对比
1 自动化测试的实践-应用QTP测试框架.pptx
qtp读写Excel文件，写测试报告，读取自动化测试数据
qtp中参数化数据时可以直接从excel中读取。