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

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

搜寻几个小时无果之后,决定自己写一个,虽然有些麻烦,总算是搞出来了。下列代码给用得到的朋友做个参考:文章源自原紫番博客-https://www.yuanzifan.com/1746.html

注意:因为用到了capturebitmap这个方法,还有获得一些参数,此段代码只可以在QTP中使用。文章源自原紫番博客-https://www.yuanzifan.com/1746.html

''''''''''''''Capture Screenshot'''''''''
Dim oExcel,ExcelBook
Dim IntCaptureCount,LngTotalRowinExcel,j
Dim strScreenshotName,strTestDir,strPicPath
Dim intSaveScreenInLine,i
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''文章源自原紫番博客-https://www.yuanzifan.com/1746.html

strScreenshotName=Environment("TestName")
strTestDir=Environment("TestDir")
strScreenshotName=strScreenshotName&"_ScreenShot.xls"文章源自原紫番博客-https://www.yuanzifan.com/1746.html

IntCaptureCount=1
intSaveScreenInLine=1文章源自原紫番博客-https://www.yuanzifan.com/1746.html

Public Function CaptureScreen()文章源自原紫番博客-https://www.yuanzifan.com/1746.html

Set objYuanZiFan=Browser("YuanZiFan.com") ''此处填写需要截图的对象名
LngTotalRowinExcel=IntCaptureCount*46
objYuanZiFan.CaptureBitmap '截图操作文章源自原紫番博客-https://www.yuanzifan.com/1746.html

strTestDir&"Screen"&IntCaptureCount&".PNG",True  ' 将截图存储于当前目录
strPicPath=strTestDir&"Screen"&IntCaptureCount&".PNG"    '文章源自原紫番博客-https://www.yuanzifan.com/1746.html

If IntCaptureCount=1 Then
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible=True
Set ExcelBook=oExcel.Workbooks.Add
End If文章源自原紫番博客-https://www.yuanzifan.com/1746.html

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文章源自原紫番博客-https://www.yuanzifan.com/1746.html

'ExcelBook.SaveAs strTestDir & strScreenshotName & strScreenshotName

End Function

站长微信
扫码添加(注明来意)
weinxin
Yuanzifan99
原梓番博客公众号
博客内容精选
weinxin
原梓番博客
 
评论  2  访客  2
    • ee 0

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

        • YuanZiFan 4

          @ ee 可以付费讲解

      发表评论

      匿名网友
      :?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:
      确定

      拖动滑块以完成验证