Search code examples
vbscriptautomated-testsqtphp-uft

How to Zoom in or Zoom out in a webpage while using UFT/QTP


I would like to control the zoom in and out feature of my webpage of the application under test using UFT. This is required as the zoom level changes dynamically and it becomes difficult to identify the objects. I have found a code but it is useful if you need to change the zoom level at one instance or at the start. below is the code

Function ChangeIEZoom
Dim intZoomLevel, objIE
intZoomLevel = 110
 Const OLECMDID_OPTICAL_ZOOM = 63
 Const OLECMDEXECOPT_DONTPROMPTUSER = 2
 Set objIE = CreateObject("InternetExplorer.Application")
 objIE.Visible = True
 objIE.Navigate ("www.google.com")
 While objIE.Busy = True
 wait 5
 Wend
 objIE.ExecWB OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(intZoomLevel), vbNull
End Function

with this code, it opens up a new browser and navigates it to a URL.

I do not want it to create a new instance of the browser. What I need is that it changes the zoom level on the same page which is already under test execution, also the page where zoom level change is required not known at the start and it may or may not require change based on the fact that it identifies certain objects.

Has anyone faced the same issue or has a solution to it ?


Solution

  • I found a solution - combining what you mentioned in comments. this works if you want to change the zoom level on current webpage you are working on. helps when you want to zoom in and out at multiple instances

    Dim ShellApp
    Set ShellApp = CreateObject("Shell.Application")
    Dim ShellWindows
    Set ShellWindows = ShellApp.Windows()
    Dim intZoomLevel
    intZoomLevel = 110
    Const OLECMDID_OPTICAL_ZOOM = 63
    Const OLECMDEXECOPT_DONTPROMPTUSER = 2
    Dim i
    For i = 0 To ShellWindows.Count - 1
        If InStr(ShellWindows.Item(i).FullName, "iexplore.exe") <> 0 Then
            Set IEObject = ShellWindows.Item(i) 
        End If
        If IEObject.Visible = True Then
        While IEObject.Busy = True
         wait 5
        Wend
         IEObject.ExecWB OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(intZoomLevel), vbNull    
        End If
    Next
    print "it works"