inserting image in selected sheets vba code

dss28

Board Regular
Joined
Sep 3, 2020
Messages
61
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
 

Some videos you may like

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

LazyBug

Board Regular
Joined
Feb 28, 2020
Messages
158
Office Version
  1. 2010
Platform
  1. Windows
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
 
Solution

dss28

Board Regular
Joined
Sep 3, 2020
Messages
61
Office Version
  1. 2007
Platform
  1. Windows
thanks , resolved
 

Watch MrExcel Video

Forum statistics

Threads
1,127,098
Messages
5,622,678
Members
415,920
Latest member
ExcelNoob28

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
Top