inserting image in selected sheets vba code

dss28

Board Regular
Joined
Sep 3, 2020
Messages
165
Office Version
  1. 2007
Platform
  1. Windows
I want to insert a picture to set the logo of the department in 3 selected sheets via vba code.

By the code given below I am able to insert the picture in only one sheet at a given place and position and size.

when the command button to run the code is clicked, the window to select and attach picture opens three times but it inserts picture only in one sheet.

I want that the window to select and attach a picture should open only once and perform the picture addition in three sheets all at once.

Can anybody help me in providing the code to insert the picture in the three sheets at once?


VBA Code:
Sub GetPic()
Dim fNameAndPath As Variant
Dim img As Picture
 

ThisWorkbook.Sheets("Sheet1").Activate
ThisWorkbook.Sheets("Sheet3").Activate
ThisWorkbook.Sheets("Sheet5").Activate


fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")

If fNameAndPath = False Then Exit Sub
 
    Set img = ActiveSheet.Pictures.Insert(fNameAndPath)
    With img
       'Resize Picture to fit in the range....
       .ShapeRange.LockAspectRatio = msoFalse              ' lock aspect ratio checkbox not selected
       .Left = ActiveSheet.Range("E3").Left
       .Top = ActiveSheet.Range("E3").Top
       .Width = ActiveSheet.Range("E3:G3").Width
       .Height = ActiveSheet.Range("E3:E5").Height
       .Placement = 1
       .PrintObject = True
      

End With
 
End Sub
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Maybe
VBA Code:
Option Explicit

Sub GetPic()
Dim fNameAndPath As Variant
Dim img As Picture
Dim SheetsNames(), i As Long

SheetsNames = Array("Sheet1", "Sheet3", "Sheet5")
fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")

If fNameAndPath = False Then Exit Sub
 
    For i = LBound(SheetsNames) To UBound(SheetsNames)
        Set img = ActiveWorkbook.Sheets(SheetsNames(i)).Pictures.Insert(fNameAndPath)
        With img
           'Resize Picture to fit in the range....
           .ShapeRange.LockAspectRatio = msoFalse              ' lock aspect ratio checkbox not selected
           .Left = ActiveSheet.Range("E3").Left
           .Top = ActiveSheet.Range("E3").Top
           .Width = ActiveSheet.Range("E3:G3").Width
           .Height = ActiveSheet.Range("E3:E5").Height
           .Placement = 1
           .PrintObject = True
        End With
    Next i
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top