Qtp report生成模板

seagull1985

Class excelreporterengine
   Private oEngine
   
   Private objSheet
   
      Private objWorkBook
   Public str_ScriptPath
   
    Private Sub Class_Initialize   
      str_ScriptPath = str_Test_Path&"Report\"
      
      me.StartReportEngine GetTestName,"Result.xls"
      me.OpenExcelFile  me.str_ScriptPath&GetTestName&"\"&"Result.xls"
                                
      
      End Sub
   
   Private Sub Class_Terminate      
   me.CloseExcelFile
   Set objWorkBook = Nothing
   Set objSheet = nothing
      Set  oEngine =nothing
   End Sub
   
   
   
   'create a folder
   Function Createreporterfolder(str_folderpath)
   Dim fso, f
   Set fso = CreateObject("Scripting.FileSystemObject")
   
      If not fso.FolderExists(str_folderpath)  Then
      
      Set f = fso.CreateFolder(str_folderpath)
      Set f = Nothing
      Set fso = Nothing
      Else
      Set fso = Nothing
      End If
   End Function

louqqson008

看着头晕啊

hinaeddie

請問 Error Message 要如何取得？sDetails 怎麼來的？

zeng0848

好东西，顶起

seagull1985

.Range("C8").Value = .Range("C8").Value + 1
   'Update the End Time
   .Range("C5").Value = Time

   'Set Column width
   .Columns("B").Select
   .Columns("B").Autofit
  End With

  'Select the Result Sheet
  Set objSheet = oEngine.Sheets("Test_Result")
  oEngine.Sheets("Test_Result").Select
  With objSheet
   'Enter the Result
   If NewTC Then
    .Range("A" & Row & ":E" & Row).Interior.ColorIndex = 37
    .Range("A" & Row & ":E" & Row).Merge
    Row = Row + 1
    .Range("A" & Row & ":E" & Row).Merge  
    .Range("A" & Row).Value = TestcaseName
    'Set color and Fonts for the Header
    .Range("A" & Row & ":E" & Row).Interior.ColorIndex = 2
    .Range("A" & Row & ":E" & Row).Font.ColorIndex = 23
    .Range("A" & Row & ":E" & Row).Font.Bold = True
    Row = Row + 1
   End If
   .Range("A" & Row).Value = sStepName
   'oEngine.Selection.ShapeRange.ScaleWidth 1.72, msoFalse, msoScaleFromTopLeft
   'oEngine.Selection.ShapeRange.ScaleHeight 1.81, msoFalse, msoScaleFromTopLeft
   
   .Range("B" & Row).Value = sStatus
   .Range("B" & Row).Font.Bold = True     
   
   Select Case sStatus
    Case "ass"
     .Range("A" & Row & ":E" & Row).Font.ColorIndex = 50
    Case "Fail"
     .Range("A" & Row & ":E" & Row).Font.ColorIndex = 3
    Case "Warning"
     .Range("A" & Row & ":E" & Row).Font.ColorIndex = 46
   End Select
   .Range("B" & Row).Font.Bold = True
   .Range("C" & Row).Value = sExpected
   .Range("D" & Row).Value = sActual
   .Range("E" & Row).Value = sDetails

   'Set the Borders
   .Range("A" & Row & ":E" & Row).Borders(1).LineStyle = 1
   .Range("A" & Row & ":E" & Row).Borders(2).LineStyle = 1
   .Range("A" & Row & ":E" & Row).Borders(3).LineStyle = 1
   .Range("A" & Row & ":E" & Row).Borders(4).LineStyle = 1
   .Range("A" & Row & ":E" & Row).VerticalAlignment = -4160

  End With
  oEngine.Sheets("Test_Summary").Select
  oEngine.Sheets("Test_Summary").Range("B1").Select
  'Save the Workbook
  objWorkBook.Save
  
  
End Sub
End Class
Set oReporterManager = new excelreporterengine

seagull1985

Public Sub Report (sStatus, sStepName,sExpected,sActual, sDetails)
   
  Dim TestcaseName
  Dim Row, TCRow, NewTC
  TestcaseName = Environment("ActionName") & " > Iteration (Test-Action) = " & Environment("TestIteration") & "-" & Environment("ActionIteration")
      
  'Open the Result file
    ' Set objWorkBook = oEngine.Workbooks.Open (oSettings("File"))
  'Select the Summery Sheet
  Set objSheet = oEngine.Sheets("Test_Summary")
  oEngine.Sheets("Test_Summary").Select
  
  
  
  With objSheet
   'Note the Row No. on which to Report the result
   Row = .Range("C8").Value + 2*.Range("C7").Value + 2
   TCRow = .Range("C7").Value + 11
   NewTC = False
   .Range("F" & TCRow).Font.ColorIndex = 3
   .Range("E" & TCRow).Font.ColorIndex = 50
   .Range("G" & TCRow).Font.ColorIndex = 46
   
   
   
   
   'Check if it is a new Tetstcase
   If objSheet.Cells(TCRow - 1, 2).Value <> TestcaseName Then
    .Cells(TCRow, 2).Value = TestcaseName
    oEngine.ActiveSheet.Hyperlinks.Add objSheet.Cells(TCRow, 2), "", "Test_Result!A" & Row+1, TestcaseName
    .Cells(TCRow, 3).Value = sStatus
     .Range("F" & TCRow).Value = "0"
           .Range("E" & TCRow).Value = "0"  
           .Range("G" & TCRow).Value = "0"
   
   
    Select Case sStatus
     Case "Fail"
      .Range("C" & TCRow).Font.ColorIndex = 3         
      .Range("F" & TCRow).Value = "1"
     Case "Pass"
      .Range("C" & TCRow).Font.ColorIndex = 50        
      .Range("E" & TCRow).Value = "1"   
     Case "Warning"
      .Range("C" & TCRow).Font.ColorIndex = 46        
      .Range("G" & TCRow).Value = "1"
    End Select
   
   
    'The first step.
    .Cells(TCRow, 4).Value = 1  '(D,11)
   
    NewTC = True
   
    'it is a new Testcase
   
    .Range("C7").Value = .Range("C7").Value + 1  'count the cases.
   
    'Set the Borders for the Result Header
    .Range("B" & TCRow & ":G" & TCRow).Borders(1).LineStyle = 1
    .Range("B" & TCRow & ":G" & TCRow).Borders(2).LineStyle = 1
    .Range("B" & TCRow & ":G" & TCRow).Borders(3).LineStyle = 1
    .Range("B" & TCRow & ":G" & TCRow).Borders(4).LineStyle = 1
    'Set color and Fonts for the Header
    .Range("B" & TCRow & ":G" & TCRow).Interior.ColorIndex = 2
    .Range("B" & TCRow).Font.ColorIndex = 23
    .Range("B" & TCRow & ":G" & TCRow).Font.Bold = True
   
   
    '====NOT A NEW CASE================================================================
   
   Else
    .Range("D" & TCRow-1).Value = .Range("D" & TCRow-1).Value + 1
    Select Case sStatus
     Case "Fail"      
      .Range("F" & TCRow-1).Value = .Range("F" & TCRow-1).Value +1
     Case "Pass"      
      .Range("E" & TCRow-1).Value = .Range("E" & TCRow-1).Value +1      
     Case "Warning"      
      .Range("G" & TCRow-1).Value = .Range("G" & TCRow-1).Value +1  
    End Select
   End If
   
   If (Not NewTC) And (sStatus = "Fail") Then
    .Cells(TCRow-1, 3).Value = "Fail"
    .Range("C" & TCRow-1).Font.ColorIndex = 3
   
   End If
   If (Not NewTC) And (sStatus = "Warning") Then
      
    If .Cells(TCRow-1, 3).Value = "Pass" Then
     .Cells(TCRow-1, 3).Value = "Warning"
     .Range("C" & TCRow-1).Font.ColorIndex = 46
    End If
            
   End If

seagull1985

'Get the object of the first sheet in the workbook
     Set objSheet = oEngine.Sheets.Item(2)
     oEngine.Sheets.Item(1).Select
     With objSheet
      
      'Rename the first sheet to "Test_Result"
      .Name = "Test_Result"
      
      'Set the Column widths
      .Columns("A:A").ColumnWidth = 30
      .Columns("B:B").ColumnWidth = 15
      .Columns("C").ColumnWidth = 35
      .Columns("E:E").ColumnWidth = 35
      .Columns("A:E").HorizontalAlignment = -4131
      .Columns("A:E").WrapText = True
        
      'Set the Heading for the Result Columns
      .Range("A1").Value = "STEP NAME"
      .Range("B1").Value = "STATUS"
      .Range("C1").Value = "EXPECTED RESULT"
      .Range("D1").Value = "ACTUAL RESULT"
      .Range("E1").Value = "ERROR MESSAGE"
      
      'Format the Heading for the Result Columns
      .Range("A1:E1").Interior.ColorIndex = 23
      .Range("A1:E1").Font.ColorIndex = 2
      .Range("A1:E1").Font.Bold = True
   
      'Set the Borders for the Result Header
      .Range("A1:E1").Borders(1).LineStyle = 1
      .Range("A1:E1").Borders(2).LineStyle = 1
      .Range("A1:E1").Borders(3).LineStyle = 1
      .Range("A1:E1").Borders(4).LineStyle = 1
   '     .Range("A2").Select
     End With
     'Freez pane
     oEngine.ActiveWindow.FreezePanes = True
   
     'Save the Workbook at the specified Path with the Specified Name
     oEngine.ActiveWorkbook.saveas FilePath
     oEngine.Workbooks.close
     oEngine.quit
     
     'Relese the Object
     Set objSheet = Nothing
   End If
   Set fso = Nothing
   End Function
   
   'openExcelfile
   Function OpenExcelFile(Excelpath)
     Set oEngine = CreateObject("Excel.Application")
     Set objWorkBook =  oEngine.Workbooks.Open(Excelpath)
   end Function
   
     Function CloseExcelFile()
                   oEngine.ActiveWorkbook.save
     oEngine.Workbooks.close
     oEngine.quit
     End Function
   
   Function StartReportEngine(str_foldername,str_filename)
    Createreporterfolder(str_ScriptPath&str_foldername)
    CreateResultFile(str_ScriptPath&str_foldername&"\"&str_filename)  
   End Function

seagull1985

'create a excelfile  and initialize
     Function CreateResultFile(FilePath)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
     If not  fso.FileExists(FilePath)Then
     
   
     Set oEngine = CreateObject("excel.Application")
                  
     'Disable alerts
     oEngine.DisplayAlerts = False
     
     'Add a workbook to the Excel App
     oEngine.Workbooks.Add
     
     'Get the object of the first sheet in the workbook
     Set objSheet = oEngine.Sheets.Item(1)
     oEngine.Sheets.Item(1).Select
     With objSheet
      'Rename the first sheet to "Test_Summery"
      .Name = "Test_Summary"
      'Set the Heading
      .Range("B1").Value = "Test Results"
      .Range("B1:C1").Merge  
      'Set color and Fonts for the Header
      .Range("B1:C1").Interior.ColorIndex = 23
      .Range("B1:C1").Font.ColorIndex = 2
      .Range("B1:C1").Font.Bold = True
   
      'Set the Date and time of Execution
      .Range("B3").Value = "Test Date: "
      .Range("B4").Value = "Test Start Time: "
      .Range("B5").Value = "Test End Time: "
      .Range("B6").Value = "Test Duration: "   
      .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;@"
      
      'Set the Borders for the Date & Time Cells
      .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
      
      'Format the Date and Time Cells
      .Range("B3:C8").Interior.ColorIndex = 37
      .Range("B3:C8").Font.ColorIndex = 1
      .Range("B3:A8").Font.Bold = True
   
      'Track the Row Count and insrtuct the viewer not to disturb this
      .Range("C7").AddComment
      .Range("C7").Comment.Visible = False
      .Range("C7").Comment.Text "This is a very Important field for the script." & vbCrLf & "Please Do not Edit or Delete."
      .Range("C7").Value = "0"
      .Range("B7").Value = "Number Of Testcases:"
   
      'Track the Testcase Count Count and insrtuct the viewer not to disturb this
      .Range("C8").AddComment
      .Range("C8").Comment.Visible = False
      .Range("C8").Comment.Text "This is a very Important field for the script." & vbCrLf & "Please Do not Edit or Delete."
      .Range("C8").Value = "0"
      .Range("B8").Value = "Total Number Of Test Steps:"
      
      .Range("B10").Value = "TestCase Name"
      .Range("C10").Value = "Status"
      .Range("D10").Value = "Number Of Steps"      
      .Range("E10").Value = "Pass"
      .Range("F10").Value = "Fail"
      .Range("G10").Value = "Warning"
      .Range("H10").Value = "*Click the TestCase Name to see detail result."
      
      
      
      'Format the Heading for the Result Summery
      .Range("B10:G10").Interior.ColorIndex = 23
      .Range("B10:G10").Font.ColorIndex = 2
      .Range("B10:G10").Font.Bold = True
   
      'Set the Borders for the Result Summery
      .Range("B10:G10").Borders(1).LineStyle = 1
      .Range("B10:G10").Borders(2).LineStyle = 1
      .Range("B10:G10").Borders(3).LineStyle = 1
      .Range("B10:G10").Borders(4).LineStyle = 1
   
      'Set Column width
      .Columns("B:G").Select
      .Columns("B:G").Autofit
   
      .Range("B11").Select
     End With
     'Freez pane
     oEngine.ActiveWindow.FreezePanes = True