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

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 ?

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"

Related

Load control from array of controls

this is my code
Function GenerateInterface()
Dim ObjectsArray() As VB.Control
Dim TmpCtrl As VB.Control
ReDim ObjectsArray(1)
For Each TmpCtrl In Me.Controls
If TmpCtrl.Container Is frConfigVars(0) Then
Set ObjectsArray(UBound(ObjectsArray) - 1) = TmpCtrl
ReDim Preserve ObjectsArray(UBound(ObjectsArray) + 1)
End If
Next TmpCtrl
For i = 1 To UBound(Variables) - 1 'global array containing how many frames I need
Load frConfigVars(i)
frConfigVars(i).Left = 0
frConfigVars(i).top = frConfigVars(i - 1).top + frConfigVars(i - 1).Height
frConfigVars(i).Visible = True
For x = 0 To UBound(ObjectsArray) - 1
Set TmpCtrl = ObjectsArray(x)
Load TmpCtrl(i) '<-- crashes here
'stuff to move and view new object
Next x
Next i
End Function
It basically loads into a controls array the 0-indexed objects present in the frame to make me dinamycally load them how many times I need but I can't manage to load a new control from a variable itself.
I kinda got why that loading is crashing, I'm guessing the TmpCtrl contains (example) txtbox(0) and not txtbox, which I'd need to load the new object, correct?
If so, how can I load the new control?
I can't create objects from scratch because there are many of them and positioning would be hell
I can't call them by their name because with time I will add/remove some stuff so I don't want to touch this function again once it works
Thanks
Ok, I actually made it myself!
To access the object array itself I just need to change
Set TmpCtrl = ObjectsArray(x)
into
Set TmpCtrl = Me.Controls(ObjectsArray(x).Name)

Is it possible to display multiple images on 1 picturebox in running mode

When I try to google it for 3 days, I found that there is only 1 picture/image available in 1 picbox. My goal is to display multiple images, and they cannot overlap. If they overlap, there a red colour should be shown.
I'm using VB6. I'm using 1 combobox1, for select image n 1 commandbutoon. but when I select 2nd image in click button, the image on picbox will auto overwrite it. Is it caused by .cls ??
Private Sub Combo1_Click()
Dim pin As String
Dim intx As Integer
If UCase$(Combo1.List(intx)) = UCase$(pin) Then
Combo1.ListIndex = intx
End If
End Sub
Private Sub Command1_Click()
If Combo1.ListIndex = 0 Then
Set mPic = pin8.Image
ElseIf Combo1.ListIndex = 1 Then
Set mPic = pin12.Image
Else
Set mPic = pin16.Image
End If
mPicWidth = Me.ScaleX(mPic.Width, vbHimetric, Picture1.ScaleMode)
mPicHeight = Me.ScaleY(mPic.Height, vbHimetric, Picture1.ScaleMode)
ShowPictureAtPosition mLeft, mTop
End Sub
Thank you.
Best regard,
chan
Look, The only way to do that is to add 2 images as resources in the project then make one is the default picture or leave it blank as you wish.
The process now is when you click on the command button you switch between the two pictures.
Button Code:
if
PictureBox1.Image = My.Resources.<Name_of_res_file>.<Name_of_image1111_resource>
Then
PictureBox1.Image = My.Resources.<Name_of_res_file>.<Name_of_image2222_resource>
Else
PictureBox1.Image = My.Resources.<Name_of_res_file>.<Name_of_image1111_resource>
End If
This will switch between the 2 pictures. Hope this helps you.

Using VBA to change Picture

I am trying to use VBA to automate the Change Picture function when you right click a Shape in Excel/Word/Powerpoint.
However, I am not able to find any reference, can you assist?
So far as I know you can't change the source of a picture, you need to delete the old one and insert a new one
Here's a start
strPic ="Picture Name"
Set shp = ws.Shapes(strPic)
'Capture properties of exisitng picture such as location and size
With shp
t = .Top
l = .Left
h = .Height
w = .Width
End With
ws.Shapes(strPic).Delete
Set shp = ws.Shapes.AddPicture("Y:\our\Picture\Path\And\File.Name", msoFalse, msoTrue, l, t, w, h)
shp.Name = strPic
shp.ScaleHeight Factor:=1, RelativeToOriginalSize:=msoTrue
shp.ScaleWidth Factor:=1, RelativeToOriginalSize:=msoTrue
You can change the source of a picture using the UserPicture method as applied to a rectangle shape. However, you will need to resize the rectangle accordingly if you wish to maintain the picture's original aspect ratio, as the picture will take the dimensions of the rectangle.
As an example:
ActivePresentation.Slides(2).Shapes(shapeId).Fill.UserPicture ("C:\image.png")
'change picture without change image size
Sub change_picture()
strPic = "Picture 1"
Set shp = Worksheets(1).Shapes(strPic)
'Capture properties of exisitng picture such as location and size
With shp
t = .Top
l = .Left
h = .Height
w = .Width
End With
Worksheets(1).Shapes(strPic).Delete
Set shp = Worksheets(1).Shapes.AddPicture("d:\pic\1.png", msoFalse, msoTrue, l, t, w, h)
shp.Name = strPic
End Sub
what I do is lay both images on top of eachother, and assign the macro below to both images. Obviously i've named the images "lighton" and "lightoff", so make sure you change that to your images.
Sub lightonoff()
If ActiveSheet.Shapes.Range(Array("lighton")).Visible = False Then
ActiveSheet.Shapes.Range(Array("lighton")).Visible = True
Else
ActiveSheet.Shapes.Range(Array("lighton")).Visible = False
End If
End Sub
What I've done in the past is create several image controls on the form and lay them on top of each other. Then you programmatically set all images .visible = false except the one you want to show.
In Word 2010 VBA it helps to change the .visible option for that picture element you want to change.
set the .visible to false
change the picture
set the .visilbe to true
that worked for me.
I tried to imitate the original function of 'Change Picture' with VBA in PowerPoinT(PPT)
The code below tries to recover following properties of the original picture:
- .Left, .Top, .Width, .Height
- zOrder
- Shape Name
- HyperLink/ Action Settings
- Animation Effects
Option Explicit
Sub ChangePicture()
Dim sld As Slide
Dim pic As Shape, shp As Shape
Dim x As Single, y As Single, w As Single, h As Single
Dim PrevName As String
Dim z As Long
Dim actions As ActionSettings
Dim HasAnim As Boolean
Dim PictureFile As String
Dim i As Long
On Error GoTo ErrExit:
If ActiveWindow.Selection.Type <> ppSelectionShapes Then MsgBox "Select a picture first": Exit Sub
Set pic = ActiveWindow.Selection.ShapeRange(1)
On Error GoTo 0
'Open FileDialog
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Picture File", "*.emf;*.jpg;*.png;*.gif;*.bmp"
.InitialFileName = ActivePresentation.Path & "\"
If .Show Then PictureFile = .SelectedItems(1) Else Exit Sub
End With
'save some properties of the original picture
x = pic.Left
y = pic.Top
w = pic.Width
h = pic.Height
PrevName = pic.Name
z = pic.ZOrderPosition
Set actions = pic.ActionSettings 'Hyperlink and action settings
Set sld = pic.Parent
If Not sld.TimeLine.MainSequence.FindFirstAnimationFor(pic) Is Nothing Then
pic.PickupAnimation 'animation effect <- only supported in ver 2010 above
HasAnim = True
End If
'insert new picture on the slide
Set shp = sld.Shapes.AddPicture(PictureFile, False, True, x, y)
'recover original property
With shp
.Name = "Copied_ " & PrevName
.LockAspectRatio = False
.Width = w
.Height = h
If HasAnim Then .ApplyAnimation 'recover animation effects
'recover shape order
.ZOrder msoSendToBack
While .ZOrderPosition < z
.ZOrder msoBringForward
Wend
'recover actions
For i = 1 To actions.Count
.ActionSettings(i).action = actions(i).action
.ActionSettings(i).Run = actions(i).Run
.ActionSettings(i).Hyperlink.Address = actions(i).Hyperlink.Address
.ActionSettings(i).Hyperlink.SubAddress = actions(i).Hyperlink.SubAddress
Next i
End With
'delete the old one
pic.Delete
shp.Name = Mid(shp.Name, 8) 'recover name
ErrExit:
Set shp = Nothing
Set pic = Nothing
Set sld = Nothing
End Sub
How to use:
I suggest you to add this macro into the Quick Access Toolbar list.
(Goto Option or Right-click on the Ribbon menu))
First, select a Picture on the slide which you want to change.
Then, if the FileDialog window opens, choose a new picture.
It's done. By using this method, you can bypass the 'Bing Search and One-Drive Window' in ver 2016 when you want to change a picture.
In the code, there might(or should) be some mistakes or something missing.
I'd appreciate it if somebody or any moderator correct those errors in the code.
But mostly, I found that it works fine.
Also, I admit that there are still more properties of the original shape to recover - like the line property of the shape, transparency, pictureformat and so on.
I think this can be a beginning for people who want to duplicate those TOO MANY properties of a shape.
I hope this is helpful to somebody.
i use this code :
Sub changePic(oshp As shape)
Dim osld As Slide
Set osld = oshp.Parent
osld.Shapes("ltkGambar").Fill.UserPicture (ActivePresentation.Path & "\" & oshp.Name & ".png")
End Sub
I'm working in Excel and VBA. I can't overlay images because I have multiple sheets of a variable number and each sheet has the images, so the file would get huge if, say 20 sheets had all 5 images I want to animate.
So I used a combination of these tricks listed here:
1) I inserted an RECTANGLE shape at the location and size I wanted:
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 1024#, 512#, 186#, 130#).Select
Selection.Name = "SCOTS_WIZARD"
With Selection.ShapeRange.Fill
.Visible = msoTrue
.UserPicture "G:\Users\ScotLouis\Documents\My Spreadsheets\WordFind Wizard\WordFind Wizard 1.jpg"
.TextureTile = msoFalse
End With
2) Now to animate (change) the picture, I only need to change the Shape.Fill.UserPicture:
ActiveSheet.Shapes("SCOTS_WIZARD").Fill.UserPicture _
"G:\Users\ScotLouis\Documents\My Spreadsheets\WordFind Wizard\WordFind Wizard 2.jpg"
So I've accomplished my goal of only having 1 picture per sheet (not 5 as in my animation) and duplicating the sheet only duplicates the active picture, so the animation continues seamlessly with the next picture.
![Please find attached code.
First create a shape in PPT and run the code]1

Is there an Alternative to using the LoadPicture("bmp_or_icon_file_path") to loading Images in Excel 2007 VBA

I have an Excel 2007 Worksheet with many buttons and labels that act as menu options (i.e. user clicks the buttons, labels with images) and is presented with forms, or some thing else.
These images / icons for the buttons and labels are loaded in VBA by assigning the Picture property of the Control and calling LoadPicture() method with the full image file path as parameter, like So.
With SomeFormObject
.cmdOpenFile.Picture = LoadPicture("F:\projectname\images\fileopen.BMP")
End With
This method of loading images for buttons, other controls is causing 2 issues.
1) It creates a dependency on the image files and physical location for every user, so if a user does not have the drive mapped and files present, the VBA fails with runtime error of file or path not found.
2)
The app gets very slow if the images are on a shared drive (which is the case)
I want to eliminate both issues and somehow load icons, images into control internally, without any external dependencies on external image files.
What is the best way to achieve this in Excel 2007 VBA?
I could not file any Visual Basic 6.0 / Visual Studio style "Resource File Editor" / feature with which to accomplish this.
Please advice! thank you
-Shiva #
mycodetrip.com
I really hope that there is a easier way to do this, but this is the only one I found:
The Idea is:
You keep the Pictures embedded in a Sheet and every time you want to set the pictures for the Command you export them from your worksheet to a file and load them through LoadPicture. The only way to export an embedded Picture through VBA that I found is by making it a Chart first.
The following code is based on 'Export pictures from Excel' from johnske
Option Explicit
Sub setAllPictures()
setPicture "Picture 18", "CommandButtonOpen"
setPicture "Picture 3", "CommandButtonClose"
End Sub
Sub setPicture(pictureName As String, commandName As String)
Dim pictureSheet As Worksheet
Dim targetSheet As Worksheet
Dim embeddedPicture As Picture
Dim pictureChart As Chart
Dim MyPicture As String
Dim PicWidth As Long
Dim PicHeight As Long
Set pictureSheet = Sheets("NameOfYourPictureSheet") ' <- to Change '
Set targetSheet = Sheets("NameOfYourSheet") ' <- to Change '
Set embeddedPicture = pictureSheet.Shapes(pictureName).OLEFormat.Object
With embeddedPicture
MyPicture = .Name
PicHeight = .ShapeRange.Height
PicWidth = .ShapeRange.Width
End With
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:=pictureSheet.Name
Set pictureChart = ActiveChart
embeddedPicture.Border.LineStyle = 0
With pictureChart.Parent
.Width = PicWidth
.Height = PicHeight
End With
With pictureSheet
.Select
.Shapes(MyPicture).Copy
With pictureChart
.ChartArea.Select
.Paste
End With
.ChartObjects(1).Chart.Export Filename:="temp.jpg", FilterName:="jpg"
End With
pictureChart.Parent.Delete
Application.ScreenUpdating = True
targetSheet.Shapes(commandName).OLEFormat.Object.Object.Picture = LoadPicture("temp.jpg")
Set pictureChart = Nothing
Set embeddedPicture = Nothing
Set targetSheet = Nothing
Set pictureSheet = Nothing
End Sub
Sub listPictures()
' Helper Function to get the Names of the Picture-Shapes '
Dim pictureSheet As Worksheet
Dim sheetShape As Shape
Set pictureSheet = Sheets("NameOfYourSheet")
For Each sheetShape In pictureSheet.Shapes
If Left(sheetShape.Name, 7) = "Picture" Then Debug.Print sheetShape.Name
Next sheetShape
Set sheetShape = Nothing
Set pictureSheet = Nothing
End Sub
To Conclude:
Loading the Images from a Mapped Networked Drive seems less messy, and there shouldn't be that much of a speed difference.
2 alternatives i can think of: form.img.picture=pastepicture , and = oleobjects("ActiveXPictureName").object.picture.

Clicking on a link that contains a certain string in VBS

I'm trying to run an automated vbs script that clicks on a link on a page. I have things of the form:
Const READYSTATE_COMPLETE = 4
Set IE = CreateObject("INTERNETEXPLORER.APPLICATION")
IE.Visible = true
IE.navigate ("http://mywebpage.com")
How do I then make it click on a link on that page that doesn't have an ID but is like
ClickMe!
Thanks!
Along the lines of
Dim LinkHref
Dim a
LinkHref = "link"
For Each a In IE.Document.GetElementsByTagName("A")
If LCase(a.GetAttribute("href")) = LCase(LinkHref) Then
a.Click
Exit For ''# to stop after the first hit
End If
Next
Instead of LCase(…) = LCase(…) you could also use StrComp(…, …, vbTextCompare) (see StrComp() on the MSDN).

Resources