QTP中:使用VBS调用Excel截图功能

  • 2
  • 2,953 views
  • A+
所属分类:技术流

因为需要将测试截图存储于Execl中,但是网上找到的代码都是只能截一张图的,如果截多张会导致所有图都在第一排。而QTP自带的那个截图软件事实上只能得到一张图片,还得自己想办法将图导入到Excel。

搜寻几个小时无果之后,决定自己写一个,虽然有些麻烦,总算是搞出来了。下列代码给用得到的朋友做个参考:

注意:因为用到了capturebitmap这个方法,还有获得一些参数,此段代码只可以在QTP中使用。

''''''''''''''Capture Screenshot'''''''''
Dim oExcel,ExcelBook
Dim IntCaptureCount,LngTotalRowinExcel,j
Dim strScreenshotName,strTestDir,strPicPath
Dim intSaveScreenInLine,i
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

strScreenshotName=Environment("TestName")
strTestDir=Environment("TestDir")
strScreenshotName=strScreenshotName&"_ScreenShot.xls"

IntCaptureCount=1
intSaveScreenInLine=1

Public Function CaptureScreen()

Set objYuanZiFan=Browser("YuanZiFan.com") ''此处填写需要截图的对象名
LngTotalRowinExcel=IntCaptureCount*46
objYuanZiFan.CaptureBitmap '截图操作

strTestDir&"Screen"&IntCaptureCount&".PNG",True? ' 将截图存储于当前目录
strPicPath=strTestDir&"Screen"&IntCaptureCount&".PNG"??? '

If IntCaptureCount=1 Then
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible=True
Set ExcelBook=oExcel.Workbooks.Add
End If

For j=LngTotalRowinExcel to LngTotalRowinExcel step 46
oExcel.ActiveSheet.Range("A"&j).select
i=j-45
With ?? ?oExcel.ActiveSheet.Pictures.Insert(strPicPath)
'?? ??? ??? ??? ??? ?.ShapeRange.LockAspectRatio=msoFalse
'?? ??? ??? ??? ?.Placement=xlMoveAndSize
.ShapeRange.Left=oExcel.ActiveSheet.Range("A"&i).Left
.ShapeRange.Top=oExcel.ActiveSheet.Range("A"&(i+1)).top
.ShapeRange.Height=oExcel.ActiveSheet.Range("A"&i&":A"&(i+43)).height
.ShapeRange.Width=oExcel.ActiveSheet.Range("A"&i&":P"&i).width
End With
Next
intSaveScreenInLine=IntCaptureCount*46
IntCaptureCount=IntCaptureCount+1

'ExcelBook.SaveAs strTestDir & strScreenshotName & strScreenshotName

End Function

发表评论

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

目前评论:2   其中:访客  2   博主  0

    • ee 0

      可以解释一下具体每段代码的意思吗?

        • YuanZiFan 4

          @ee 可以付费讲解