QTP测试报告输出

这个报告输出是根据网上的Reporter9框架修改出来得，简化了一些，我个人觉得实用性比较高一点，最近看到论坛里面很多人问这个问题，希望能帮到大家

'************************************************************************************************
'******************XXXXXXXXXxXXXXX有限公司--XXXXX系统自动化脚本******************************
'************************************************************************************************
'****************       脚本名称: 报告模块                                   ********************
'****************       脚本版本: 1.0                                        ********************
'****************       脚本描述: 测试报告结果输出　　　　　　　　　　       ********************
'****************       脚本作者: 小孩 /51TESTING                          ********************
'****************       编写时间: 2008-11-11                                 ********************
'****************       脚本修改:                                            ********************
'****************       修改时间:                                            ********************
'****************       修改备注:                                            ********************
'************************************************************************************************
'************************************************************************************************

'参数: ReportExcelFile　报告输出的路径
Public ReportExcelFile
ReportExcelFile = Environment ("TestDir")& "\" & " 测试结果" & Date & "-"& Hour(Now) & Minute(Now)& Second(Now) & ".xls"

'描述：GetIP    捕获运行脚本的电脑ＩＰ
Public Function GetIP
    ComputerName="."
    Dim objWMIService,colItems,objItem,objAddress
    Set ōbjWMIService = GetObject("winmgmts:\\" & ComputerName & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
    For Each objItem in colItems
        For Each objAddress in objItem.IPAddress
            If objAddress <> "" then
                GetIP = objAddress
                Exit Function
            End If
        Next
    Next
End Function

'描述：Report       报告函数
'参数: sStatus      报告的状态分别为FAIL和PASS
'参数: sDetails     注释，用来形容测试内容
Public Function Report(sStatus,sDetails)
 '定义变量
 Dim fso
 Dim oExcel
 Dim ExcelFile
 Dim TestcaseName
 Dim objWorkBook
 Dim objSheet
 Dim NewTC
 Dim Status
 
 
 Set fso = CreateObject("scrīpting.FileSystemObject")
 Set ōExcel = CreateObject("Excel.Application")
 
 Status=UCase(sStatus)
 oExcel.Visible = false 'True 
  

 '设置Excel报告样式
 If  Not fso.FileExists(ReportExcelFile)Then
  oExcel.Workbooks.Add
  
  '获取工作簿的第一个Sheet页
  Set ōbjSheet = oExcel.Sheets.Item(1)
  oExcel.Sheets.Item(1).Select
  
  With objSheet
   .Name = "测试结果"
   '设置列宽
   .Columns("A:A").ColumnWidth = 5
   .Columns("B:B").ColumnWidth = 35
   .Columns("C:C").ColumnWidth = 12.5
   .Columns("D:D").ColumnWidth = 60
   .Columns("A:D").HorizontalAlignment = -4131
   .Columns("A:D").WrapText = True
   '设置显示区域的字体类型和大小
   .Range("A:D").Font.Name = "Arial"
   .Range("A:D").Font.Size = 10
   
   '设置文件头格式
   .Range("B1").Value = "测试结果"
   .Range("B1:C1").Merge
    '设置文件头格式字体和颜色
   .Range("B1:C1").Interior.ColorIndex = 53
   .Range("B1:C1").Font.ColorIndex = 19
   .Range("B1:C1").Font.Bold = True
   
   '设置执行的日期和时间
   .Range("B3").Value = "测试日期:"
   .Range("B4").Value = "执行时间:"
   .Range("B5").Value = "结束时间:"
   .Range("B6").Value = "执行时长: "   
   .Range("C3").Value = Date
   .Range("C4").Value = Time
   .Range("C5").Value = Time
   .Range("C6").Value = "=R[-1]C-R[-2]C"
   .Range("C6").NumberFormat = "[h]:mm:ss;@"
   
   '设置日期和时间cell的边界
   .Range("C3:C8").HorizontalAlignment = 4 '右边对齐
   .Range("C3:C8").Font.Bold = True
   .Range("C3:C8").Font.ColorIndex = 7
   .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
   
   '设置日期和时间Cell的样式
   .Range("B3:C8").Interior.ColorIndex = 40
   .Range("B3:C8").Font.ColorIndex = 12
   .Range("C3:C8").Font.ColorIndex = 7
   .Range("B3:A8").Font.Bold = True
   .Range("B7").Value = "执行总数:"
   .Range("C7").Value = "0"
   .Range("B8").Value = "测试机器:"
   .Range("C8").Value =GetIP()
   .Range("B10").Value = "测试业务"
   .Range("C10").Value = "结果"
   .Range("D10").Value = "注释"
   
   '为Result Summery设置格式
   .Range("B10:D10").Interior.ColorIndex = 53
   .Range("B10:D10").Font.ColorIndex = 19
   .Range("B10:D10").Font.Bold = True
   
   '为Result Summery设置边界
   .Range("B10:D10").Borders(1).LineStyle = 1
   .Range("B10:D10").Borders(2).LineStyle = 1
   .Range("B10:D10").Borders(3).LineStyle = 1
   .Range("B10:D10").Borders(4).LineStyle = 1
   .Range("B10:D10").HorizontalAlignment = -4131
   .Range("C11:C1000").HorizontalAlignment = -4131
   .Columns("B:D").Select
   ' .Columns("B:D").Autofit
   .Range("B11").Select 
  End With
  oExcel.ActiveWindow.FreezePanes = True
  oExcel.ActiveWorkbook.SaveAs ReportExcelFile
  oExcel.Quit
  Set ōbjSheet = Nothing
 End If
 
 TestcaseName = Environment("TCase")
 Set ōbjWorkBook = oExcel.Workbooks.Open(ReportExcelFile)
 Set ōbjSheet = oExcel.Sheets("测试结果")
 
 With objSheet
 '设置行数和是否NewTc标识
  Environment.Value("Row")  = .Range("C7").Value + 11
  NewTC = False
 
  If TestcaseName <> objSheet.Cells(Environment("Row")-1,2).value Then
      .Cells(Environment("Row"),2).value = TestcaseName
      .Cells(Environment("Row"), 3).Value = Status
      .Cells(Environment("Row"), 4).value = sDetails
  
   Select Case Status
       Case "FAIL"
            .Range("C" & Environment("Row")).Font.ColorIndex = 3
       Case "PASS"
            .Range("C" & Environment("Row")).Font.ColorIndex = 50
                            Case "WARNING"
            .Range("C" & Environment("Row")).Font.ColorIndex = 5
   End Select
 
  NewTC = True
  .Range("C7").Value = .Range("C7").Value + 1
  '设置边界
  .Range("B" & Environment("Row") & ":D" & Environment("Row")).Borders(1).LineStyle = 1
  .Range("B" & Environment("Row") & ":D" & Environment("Row")).Borders(2).LineStyle = 1
  .Range("B" & Environment("Row") & ":D" & Environment("Row")).Borders(3).LineStyle = 1
  .Range("B" & Environment("Row") & ":D" & Environment("Row")).Borders(4).LineStyle = 1
  '设置字体和颜色
  .Range("B" & Environment("Row") & ":D" & Environment("Row")).Interior.ColorIndex = 19
  .Range("B" & Environment("Row")).Font.ColorIndex = 53
  .Range("D" & Environment("Row")).Font.ColorIndex = 41
  .Range("B" & Environment("Row") & ":D" & Environment("Row")).Font.Bold = True
 
 
  End If
 
  If (Not NewTC) And (Status = "FAIL") Then
   .Cells(Environment("Row"), 3).Value = "Fail"
   .Range("C" & Environment("Row")).Font.ColorIndex = 3
  end If
  
  '更新结束时间
  .Range("C5").Value = Time
  
  .Columns("B:D").Select
  '.Columns("B:D").Autofit
 End With
 oExcel.ActiveWindow.FreezePanes = True
 
 '保存结果
 objWorkBook.Save
 oExcel.Quit
 Set ōbjSheet = Nothing
 Set ōbjWorkBook = Nothing
 Set ōExcel = Nothing
 Set fso = Nothing
End Function

转载请保留：本文出自小孩的51Testing软件测试博客：http://www.51testing.com/?117535