QTP简略框架之EXCEL报表

Dim oReporterManagerSet oReporterManager = New ReportManagerCall 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 = sAuthorEnd 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_TextEnd 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