Trying To Modify VBA To Repeat This On All Sheets In The Workbook except a few

[Jingles3X]

Hi!
I have the code below, which is working to let me insert a picture in the specified location, but I am trying to have it repeat the process
on all sheets, excluding just a few. I have tried multiple ways to do it, with no success.
Can anyone make a suggestion on how to do this?

Sub GetPic()
Dim fNameAndPath As Variant
Dim img As Picture         
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....
       .Left = ActiveSheet.Range("AC1").Left
       .Top = ActiveSheet.Range("AC1").Top
       .Width = ActiveSheet.Range("AC7:AI7").Width
       .Height = ActiveSheet.Range("AC1:AC7").Height
       .Placement = 1
       .PrintObject = True
       End With

End Sub

 

[Jeffrey Mahoney]

How about this?

Sub GetPic()
  Dim fNameAndPath As Variant
  Dim img As Picture
  Dim Sht As Worksheet
  
  fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
  If fNameAndPath = False Then Exit Sub
  
  For Each Sht In ActiveWorkbook.Worksheets
    Select Case Sht.Name
      Case "NotThis", "NorThis"
        'Do Nothing
      Case Else
        Set img = ActiveSheet.Pictures.Insert(fNameAndPath)
        With img
           'Resize Picture to fit in the range....
           .Left = ActiveSheet.Range("AC1").Left
           .Top = ActiveSheet.Range("AC1").Top
           .Width = ActiveSheet.Range("AC7:AI7").Width
           .Height = ActiveSheet.Range("AC1:AC7").Height
           .Placement = 1
           .PrintObject = True
        End With
    End Select
  Next Sht
  
  

End Sub

 

[GWteB]

In which way do yo want to repeat the process? Do you want the same image on multiple worksheets? Perhaps you can explain your wish in more detail.

 

[Jingles3X]

In which way do yo want to repeat the process? Do you want the same image on multiple worksheets? Perhaps you can explain your wish in more detail.

I want to place an image on all worksheets except the first 6. I apologize for not stating that more clearly.

 

[Jingles3X]

How about this?

Sub GetPic()
  Dim fNameAndPath As Variant
  Dim img As Picture
  Dim Sht As Worksheet
 
  fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
  If fNameAndPath = False Then Exit Sub
 
  For Each Sht In ActiveWorkbook.Worksheets
    Select Case Sht.Name
      Case "NotThis", "NorThis"
        'Do Nothing
      Case Else
        Set img = ActiveSheet.Pictures.Insert(fNameAndPath)
        With img
           'Resize Picture to fit in the range....
           .Left = ActiveSheet.Range("AC1").Left
           .Top = ActiveSheet.Range("AC1").Top
           .Width = ActiveSheet.Range("AC7:AI7").Width
           .Height = ActiveSheet.Range("AC1:AC7").Height
           .Placement = 1
           .PrintObject = True
        End With
    End Select
  Next Sht
 
 

End Sub

This still seems to place the image on only the active sheet, but I am not sure if I should be making any modifications to what you have supplied. (I am very grateful for the help though!)

 

[GWteB]

I want to place an image on all worksheets except the first 6. I apologize for not stating that more clearly.

Ok, see if this works for you ...

Sub Jingles3X()
    Const SheetsToExclude As String = "*Sheet 1*Sheet 2*SomeOtherSheetName*"      ' <<< change list of sheet names to suit;
                                                                                '     the surrounding * characters should remain
    
    Dim fNameAndPath As Variant
    Dim img As Shape
    Dim Sht As Worksheet
  
    fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
    If fNameAndPath = False Then Exit Sub
  
    For Each Sht In ActiveWorkbook.Worksheets
        If Not InStr(1, SheetsToExclude, "*" & Sht.Name & "*", vbTextCompare) > 0 Then
            Set img = Sht.Shapes.AddPicture(Filename:=fNameAndPath, LinkToFile:=False, SaveWithDocument:=True, Left:=1, Top:=1, Width:=-1, Height:=-1)
            With img
                'Resize Picture to fit in the range....
                .Left = Sht.Range("AC1").Left
                .Top = Sht.Range("AC1").Top
                .Width = Sht.Range("AC7:AI7").Width
                .Height = Sht.Range("AC1:AC7").Height
                .Placement = 1
                .PrintObject = True
            End With
        End If
    Next Sht
End Sub

 

[Jingles3X]

Ok, see if this works for you ...

Sub Jingles3X()
    Const SheetsToExclude As String = "*Sheet 1*Sheet 2*SomeOtherSheetName*"      ' <<< change list of sheet names to suit;
                                                                                '     the surrounding * characters should remain
   
    Dim fNameAndPath As Variant
    Dim img As Shape
    Dim Sht As Worksheet
 
    fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
    If fNameAndPath = False Then Exit Sub
 
    For Each Sht In ActiveWorkbook.Worksheets
        If Not InStr(1, SheetsToExclude, "*" & Sht.Name & "*", vbTextCompare) > 0 Then
            Set img = Sht.Shapes.AddPicture(Filename:=fNameAndPath, LinkToFile:=False, SaveWithDocument:=True, Left:=1, Top:=1, Width:=-1, Height:=-1)
            With img
                'Resize Picture to fit in the range....
                .Left = Sht.Range("AC1").Left
                .Top = Sht.Range("AC1").Top
                .Width = Sht.Range("AC7:AI7").Width
                .Height = Sht.Range("AC1:AC7").Height
                .Placement = 1
                .PrintObject = True
            End With
        End If
    Next Sht
End Sub

.printobject=true seems to be a problem

 

[GWteB]

.printobject=true seems to be a problem

My mistake, that line should be

.DrawingObject.PrintObject = True

 

[Jingles3X]

My mistake, that line should be

.DrawingObject.PrintObject = True

This Works Perfectly! Thank you so much. Out of curiosity....what would be different if I wanted to remove the same logos?

 

[GWteB]

You're welcome and thanks for letting me know.

what would be different if I wanted to remove the same logos?

When the images are being placed on the worksheets, somehow a reference to each of the images will need to be stored at the same time in order to be able to delete them as well. This can be an object reference, stored in a VBA variable in memory. This approach has the disadvantage that such references are volatile. The moment you change something in your code within the VBE, the references are lost. Furthermore, they are also lost after you save and close the workbook. Therefore it would be better to store them on a worksheet. Since object references cannot be stored on a worksheet it is obvious to save both the name of the image and the name of the target worksheet. What you have in mind regarding these images therefore determines the approach and the final code.