QTP简单框架(7)之Excel报表

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

 

posted @ 2012-02-16 16:36  Sirrah  阅读(288)  评论(0编辑  收藏  举报