使用vbs生成的測試報告

時間 2019-11-13
標籤使用 vbs 生成測試報告简体版
原文原文鏈接
幾年前，貌似是2012年，本身作自動化時，用的還都是QTP，說實話QTP本身生成的測試報告很不直觀，通常都要本身定製測試報告。還好QTP使用的是vbs，因而本身就動手定製了一個。比較實用，下面是我基於vbs作的這個測試報告的源碼：測試
一、源碼ui
Dim varReportName        ' 測試報告文件名
Const cSheet1Name = "結果概覽"
Const cSheet2Name = "詳細結果"

'描述：GetIP    捕獲運行腳本的電腦ＩＰ
Public Function GetInfo
    ComputerName="."
    Dim objWMIService,colItems,objItem,objAddress,username,localhostname
	username = Environment("UserName")
	localhostname = Environment("LocalHostName")
    Set objWMIService = 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
                GetInfo = "本機IP："&objAddress &vbcrlf&"用戶名："&username&vbcrlf&"機器名："&localhostname
                Exit Function
            End If
        Next
    Next
End Function

Sub ExcelReport(ByVal vStatus, ByRef vDetails, ByRef vRemarks)

    Dim objExcel        ' object of Excel
    Dim objExcelBook    ' object of Excel WorkBook
    Dim vActionName        ' QTP Test Name
    Dim vSummaryRow, vResultRow, vNewAction, vUCaseStatus
    
    vActionName = Environment("TestName" )& " － " & Environment("ActionName")
'    vActionName = "ExcelReporter － Action "
    vUCaseStatus = UCase(vStatus)
    If varReportName = Empty Then
        varReportName = Environment ("TestDir")& "\" &Replace(Now,":","") & "測試報告" &".xls"
     'varReportName = "D:\測試報告" & Date & second(now)&".xls"
        Call CreateExcelReport(varReportName)
    End If
    
    Set objExcel = CreateObject("Excel.Application")
    Set objExcelBook = objExcel.Workbooks.Open(varReportName)
'    objExcel.Visible = True        'Debug
    
    ' Test Summary Sheet
    objExcel.Sheets(cSheet1Name).Select
    With objExcel.Sheets(cSheet1Name)
        vSummaryRow = .Range("C7").Value + 11
        vResultRow = .Range("C8").Value + 2*.Range("C7").Value + 2
        vNewAction = False
        
        If .Cells(vSummaryRow - 1, 2).Value <> vActionName Then        ' 新增Action
            .Cells(vSummaryRow, 2).Value = vActionName
            objExcel.ActiveSheet.Hyperlinks.Add .Cells(vSummaryRow, 2), "", cSheet2Name&"!A"&vResultRow+1, vActionName&" Result"
            .Cells(vSummaryRow, 3).Value = vStatus
            Select Case vUCaseStatus
                Case "FAIL"
                    .Range("C" & vSummaryRow).Font.ColorIndex = 3
                Case "PASS"
                    .Range("C" & vSummaryRow).Font.ColorIndex = 50
                Case "WARNING"
                    .Range("C" & vSummaryRow).Font.ColorIndex = 5              
            End Select
            vNewAction = True
            .Cells(vSummaryRow, 4).Value = 1
            .Range("C7").Value = .Range("C7").Value + 1
            'Set color and Fonts
            .Range("B" & vSummaryRow & "" & vSummaryRow).Borders(1).LineStyle = 1 
            .Range("B" & vSummaryRow & "" & vSummaryRow).Borders(2).LineStyle = 1
            .Range("B" & vSummaryRow & "" & vSummaryRow).Borders(3).LineStyle = 1
            .Range("B" & vSummaryRow & ":D" & vSummaryRow).Borders(4).LineStyle = 1
            .Range("B" & vSummaryRow & ":D" & vSummaryRow).Interior.ColorIndex = 19
            .Range("B" & vSummaryRow).Font.ColorIndex = 53
        Else
            .Range("D" & vSummaryRow-1).Value = .Range("D" & vSummaryRow-1).Value + 1
        End If
        
        If (Not vNewAction) And (vUCaseStatus = "FAIL") Then        ' 重複Action Test而且vStatus爲Fail
            .Cells(vSummaryRow-1, 3).Value = vStatus
            .Range("C" & vSummaryRow-1).Font.ColorIndex = 3
        End If

        If (Not vNewAction) And (vUCaseStatus = "PASS") Then        ' 重複Action Test而且vStatus爲Warning,若是結果爲Warning，也標註爲Pass
            If UCase(.Cells(vSummaryRow-1, 3).Value) = "PASS" Then
                .Cells(vSummaryRow-1, 3).Value = vStatus
                .Range("C" & vSummaryRow-1).Font.ColorIndex = 5
            End If
        End If

        .Range("C8").Value = .Range("C8").Value + 1
        .Range("C5").Value = Time
    End With

    ' Test Result Sheet
    objExcel.Sheets(cSheet2Name).Select
    With objExcel.Sheets(cSheet2Name)
        If vNewAction Then
            .Range("A" & vResultRow & ":D" & vResultRow).Interior.ColorIndex = 15
            .Range("A" & vResultRow & ":D" & vResultRow).Merge
            vResultRow = vResultRow + 1
            .Range("A" & vResultRow & ":D" & vResultRow).Merge
            .Range("A" & vResultRow & ":D" & vResultRow).HorizontalAlignment = 1
            .Range("A" & vResultRow).Value = vActionName
            'Set color and Fonts
            .Range("A" & vResultRow & ":D" & vResultRow).Interior.ColorIndex = 19
            .Range("A" & vResultRow & ":D" & vResultRow).Font.ColorIndex = 53
            .Range("A" & vResultRow & ":D" & vResultRow).Font.Bold = True
            vResultRow = vResultRow + 1
            .Range("A" & vResultRow).Value = "Step "&objExcel.Sheets(cSheet1Name).Range("D" & vSummaryRow).Value
        Else
            .Range("A" & vResultRow).Value = "Step "&objExcel.Sheets(cSheet1Name).Range("D" & vSummaryRow-1).Value
        End If
        .Range("B" & vResultRow).Value = vStatus
        .Range("C" & vResultRow).Value = vDetails
        .Range("D" & vResultRow).Value = vRemarks
        
        Select Case vUCaseStatus
            Case "PASS"
                .Range("B" & vResultRow).Font.ColorIndex = 50
            Case "FAIL"
                .Range("A" & vResultRow & ":E" & vResultRow).Font.ColorIndex = 3
            Case "WARNING"
                .Range("A" & vResultRow & ":E" & vResultRow).Font.ColorIndex = 5
        End Select

        'Set the Borders
        .Range("A" & vResultRow & ":D" & vResultRow).Borders(1).LineStyle = 1
        .Range("A" & vResultRow & ":D" & vResultRow).Borders(2).LineStyle = 1
        .Range("A" & vResultRow & ":D" & vResultRow).Borders(3).LineStyle = 1
        .Range("A" & vResultRow & ":D" & vResultRow).Borders(4).LineStyle = 1        
    End With
    
    objExcel.Sheets(cSheet1Name).Select
    objExcelBook.Save
    objExcel.Quit
    Set objExcelBook = Nothing
    Set objExcel = Nothing    
End Sub


'==================================================
' Create Excel Report File
'==================================================
Sub CreateExcelReport(ByRef vFileName)
    Dim fso                ' object of FSO
    Dim objExcel        ' object of Excel
    
    Set fso = CreateObject("scripting.FileSystemObject")
    Set objExcel = CreateObject("Excel.Application")
    If objExcel Is Nothing Then MsgBox "系統未檢測到安裝了EXCEL！"
    objExcel.DisplayAlerts = False
'    objExcel.Visible = True        'Debug

'    生成報告並設置格式
    If  Not fso.FileExists(varReportName) Then
        objExcel.Workbooks.Add
        ' Test Summary Sheet
        objExcel.Sheets.Item(1).Select
        With objExcel.Sheets.Item(1)
            .Name = cSheet1Name
'            設置顯示方式
            .Columns("A:A").ColumnWidth = 10
            .Columns("B:B").ColumnWidth = 45
            .Columns("C:C").ColumnWidth = 25
            .Columns("D:D").ColumnWidth = 25
            .Columns("A:D").WrapText = False
            .Columns("C:C").HorizontalAlignment = -4108        ' 4，右對齊；-4108，居中
            .Range("C3:C8").HorizontalAlignment = 4
			.Range("C9:C9").HorizontalAlignment = 1
            .Range("B10:D10").HorizontalAlignment = -4108
            .Range("A:D").VerticalAlignment = -4160
            .Range("B2:C2").Merge
            .Range("B1:C1").Interior.ColorIndex = 31
            .Range("B2:C2").Interior.ColorIndex = 31
            .Range("B10:D10").Interior.ColorIndex = 31
            .Range("B3:C9").Interior.ColorIndex = 24
            .Range("B2:C2").Font.ColorIndex = 19
            .Range("B10:D10").Font.ColorIndex = 19
            .Range("B3:C9").Font.ColorIndex = 12
            .Range("B2:B9").Borders(1).LineStyle = 1    ' 1，單線；-4115，點線；-4119，雙線
            .Range("C2:C9").Borders(2).LineStyle = 1
           ' .Range("B2:C2").Borders(3).LineStyle = 1
            .Range("B8:C9").Borders(4).LineStyle = 1
            .Range("B3:C9").Borders(3).LineStyle = 1
            .Range("C3:C9").Borders(1).LineStyle = 1
            .Range("B2:B9").Font.Bold = True
            .Range("B10:D10").Font.Bold = True
            .Range("A:D").Font.Name = "Arial"
            .Range("A:D").Font.Size = 10
			.Range("B11:B500").Font.Size = 10
            .Range("B2").Font.Size = 12
            .Range("B10:D10").Font.Size = 12
'            設置單元格內容
            .Range("B2").Value = "結果概覽"
            .Range("B3").Value = "測試日期:"
            .Range("B4").Value = "測試開始時間:"
            .Range("B5").Value = "測試結束時間:"
            .Range("B6").Value = "測試用時: "   
            .Range("B7").Value = "測試用例數:"
            .Range("B8").Value = "總運行步驟:"
			 .Range("B9").Value = "測試機器:"
            .Range("C3").Value = Date&" "&WeekDayName(Weekday(Date)) 
            .Range("C4").Value = Time
            .Range("C5").Value = Time
            .Range("C6").Value = "=R[-1]C-R[-2]C"
            .Range("C6").NumberFormat = "[h]:mm:ss;@"
            .Range("C7").Value = "0"
            .Range("C8").Value = "0"
			.Range("C9").Value =GetInfo()
            .Range("B10").Value = "用例名稱"
            .Range("C10").Value = "測試結果"
            .Range("D10").Value = "測試步驟"
           ' .Columns("B:D").Autofit
            .Range("B11").Select
           objExcel.ActiveWindow.FreezePanes = True
        End With
        ' Test Result Sheet
        objExcel.Sheets.Item(2).Select
        With objExcel.Sheets.Item(2)
            .Name = cSheet2Name
            'Set color and Fonts        
            .Columns("A:A").ColumnWidth = 45
            .Columns("B:B").ColumnWidth = 45
            .Columns("C:D").ColumnWidth = 55
            .Columns("C:D").WrapText = True
            .Columns("A:B").HorizontalAlignment = -4108        ' 4，右對齊；-4108，居中
            .Range("A:D").VerticalAlignment = -4160
            .Range("A:D").Font.Name = "Arial"
            .Range("A1:D1").Interior.ColorIndex = 31
            .Range("A1:D1").Font.ColorIndex = 19
            .Range("A1:D1").Borders(1).LineStyle = 1 
            .Range("A1:D1").Borders(2).LineStyle = 1
            .Range("A1:D1").Borders(3).LineStyle = 1
            .Range("A1:D1").Borders(4).LineStyle = 1
            .Range("A1:D1").Font.Bold = True
'            設置單元格內容
            .Range("A1").Value = "測試用例"
            .Range("B1").Value = "運行結果"
            .Range("C1").Value = "結果說明"
            .Range("D1").Value = "結果備註"
            .Range("A2").Select
           objExcel.ActiveWindow.FreezePanes = True
        End With
    
        objExcel.ActiveWorkbook.SaveAs vFileName
        objExcel.Quit
    End If
End Sub
二、演示code
直接調用上面的兩個方法便可：createExcelReport用於建立報告，ExcelReport用於添加數據。調用後的效果：orm