返回目录：excel表格制作
DataTable.ImportSheet(FileName,SheetSource,SheetDest)
DataTable.ExportSheet(FileName,DTSheet)
用上述的来方法，在脚本中导入导出源excel中的数据。对应的知是文件名，文件路径，还道有excel的sheet名。
改写了Report Manager中输出为Excel格式的部分，以方便仅需要Excel格式Report的情况下调用。e799bee5baa6e997aee7ad94e59b9ee7ad94362
可以将代码做成一个单独的Libraries文件（参考附件ExcelReport.txt）
在任何需要输出报告的地方，调用例子如下：
ExcelReport "Pass", "Test Detail A", "Test Remark A"
Option Explicit
'==================================================
' 全局变量
'==================================================
Dim varReportName ' 测试报告文件名
'==================================================
' 常数定义
'==================================================
Const cSheet1Name = "Test_Summary"
Const cSheet2Name = "Test_Result"
'==================================================
' Output Test Result to Excel File
' vStatus 测试状态，分别为Fail, Pass, Warning
' vDetails 测试内容
' vRemarks 测试备注
' Example: ExcelReport "Pass", "Test Detail A", "Test Remark A"
'==================================================
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:\QTP\ExcelReporter\" & "测试报告" & Date & ".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 = "WARNING") Then ' 重复Action Test并且vStatus为Warning
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 = 5
.Columns("B:B").ColumnWidth = 35
.Columns("C:C").ColumnWidth = 15
.Columns("D:D").ColumnWidth = 15
.Columns("A:D").WrapText = False
.Columns("C:C").HorizontalAlignment = -4108 ' 4，右对齐；-4108，居中
.Range("C3:C8").HorizontalAlignment = 4
.Range("B10:D10").HorizontalAlignment = -4108
.Range("A:D").VerticalAlignment = -4160
.Range("B2:C2").Merge
.Range("B2:C2").Interior.ColorIndex = 31
.Range("B10:D10").Interior.ColorIndex = 31
.Range("B3:C8").Interior.ColorIndex = 24
.Range("B2:C2").Font.ColorIndex = 19
.Range("B10:D10").Font.ColorIndex = 19
.Range("B3:C8").Font.ColorIndex = 12
.Range("B2:B8").Borders(1).LineStyle = -4119 ' 1，单线；-4115，点线；-4119，双线
.Range("C2:C8").Borders(2).LineStyle = -4119
.Range("B2:C2").Borders(3).LineStyle = -4119
.Range("B8:C8").Borders(4).LineStyle = -4119
.Range("B3:C8").Borders(3).LineStyle = 1
.Range("C3:C8").Borders(1).LineStyle = 1
.Range("B2:B8").Font.Bold = True
.Range("B10:D10").Font.Bold = True
.Range("A:D").Font.Size = 10
.Range("B2").Font.Size = 12
.Range("B10:D10").Font.Size = 12
' 设置单元格内容
.Range("B2").Value = "Results Summary"
.Range("B3").Value = "Test Date:"
.Range("B4").Value = "Test Start Time:"
.Range("B5").Value = "Test End Time:"
.Range("B6").Value = "Test Duration: "
.Range("B7").Value = "Test Actions:"
.Range("B8").Value = "Total Test Steps:"
.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;@"
.Range("C7").Value = "0"
.Range("C8").Value = "0"
.Range("B10").Value = "Action Name"
.Range("C10").Value = "Status"
.Range("D10").Value = "Test Steps"
' .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 = 15
.Columns("B:B").ColumnWidth = 12.5
.Columns("C:D").ColumnWidth = 45
.Columns("C:D").WrapText = True
.Columns("A:B").HorizontalAlignment = -4108 ' 4，右对齐；-4108，居中
.Range("A:D").VerticalAlignment = -4160
.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 = "Test Step"
.Range("B1").Value = "Status"
.Range("C1").Value = "Details"
.Range("D1").Value = "Remarks"
' .Range("A2").Select
' objExcel.ActiveWindow.FreezePanes = True
End With
objExcel.ActiveWorkbook.SaveAs vFileName
objExcel.Quit
End If
End Sub
什么叫“怎么使参数化后导入的数据能够正常显示”？参数化是在data table中参数化的，你还能没导入就参数化？
Function TestResult(runresult)
'创建AOM自动化模型对象
Set qtapp=CreateObject("quicktest.application")
'获取测试用例最终测试结果7a64e78988e69d83363
TestResult=runresult
Select Case runresult
Case "1"
RunResultState="Failed"
Case "0"
RunResultState="Passed"
Case micDone
RunResultState="Done"
Case micWarning
RunResultState="Warning"
Case else
'Everything is fine
' print "结果生成失败,运行结果可能为其他情况"
End Select
'RunResult="Passed"
'创建EOM自动化模型对象
set excelapp=CreateObject("excel.application")
excelapp.Visible=false
'获取当前Action名
oActionName=Environment.Value("ActionName")
'自动化测试用例模板存放目录
ExcelFilePath="D:\QTPFrameWork\自动化测试用例\自动化测试用例模板.xls"
'自动化测试用例模板Sheet名
ImportSheet="用例"
'将Excel动态导入到DataTable中
DataTable.ImportSheet ExcelFilePath,ImportSheet,oActionName
'打开自动化测试用例模板
excelapp.Workbooks.Open(ExcelFilePath)
'获取Excel中第一项的Sheet对象
Set osheet=excelapp.Sheets.Item(1)
'DataTable中总行数
getrowcount=DataTable.GetSheet(oActionName).GetRowCount
For n=1 to getrowcount
TestCaseName=DataTable.GetSheet(oActionName).GetParameter("TestCaseName").ValueByRow(n)
'print TestCaseName&oActionName
If TestCaseName=oActionName Then
'print RunResult
osheet.cells(n+1,20)=RunResultState
If RunResultState="Failed" Then
osheet.cells(n+1,20).interior.ColorIndex = 3'红色
End If
If RunResultState="Passed" Then
osheet.cells(n+1,20).interior.ColorIndex = 4'绿色
End If
If RunResultState="Warning" Then
osheet.cells(n+1,20).interior.ColorIndex = 45'橘黄
End If
If RunResultState="Done" Then
osheet.cells(n+1,20).interior.ColorIndex = 48'灰色
End If
If RunResultState="Stop" Then
osheet.cells(n+1,20).interior.ColorIndex = 33'天蓝色
End If
End If
Next
'ImportSheetName=InputBox("请输入保存为文件的名称 (.xls),文件后缀名不需要输入,默认路径为：D:\QTPFrameWork\自动化测试用例\")
'If ImportSheetName="" Then
' ExitActionIteration
' else
ImportSheetPath="D:\QTPFrameWork\自动化测试用例\自动化测试用例模板(运行结果).xls"
' End If
excelapp.DisplayAlerts=false
excelapp.save ImportSheetPath
excelapp.DisplayAlerts=true
excelapp.Quit
Set qtapp=nothing
Set excelapp=nothing
End Function
'Function test2(name2)
''Dim myname
'myname=test1("dulei")
'msgbox myname
'End Function
'
'test2(name2)
'
'Function test1(name1)
' test1=name1
'End Function
你可以在检查点函数中调用这个函数，不论成功还是失败都会执行TestResult函数