Replace Picture on all sheets

[PCTech]

Is there a way to loop through all sheets and if it finds Picture 2 delete it and insert a new picture. The following does not loop to the next sheet.

 On Error Resume Next
    For Each vs In ActiveWorkbook.Worksheets
    ActiveSheet.Shapes("Picture 2").Select
    Selection.Delete
    Range("A1").Select
    ActiveSheet.Pictures.Insert("Y:\Work Files\PRICE GUIDE\marquispb.jpg").Select
Next

Thanks,

 

[VoG]

Try

On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
    ws.Shapes("Picture 2").Delete
    ws.Pictures.Insert ("Y:\Work Files\PRICE GUIDE\marquispb.jpg")
    With ws.Shapes(ws.Shapes.Count)
        .Top = ws.Range("A1").Top
        .Left = ws.Range("A1").Left
    End With
Next ws

 

[PCTech]

Awesome, It does what I needed it to do. Now I have another issue. Some sheets have a different picture that is also referenced as "Picture 2". (Two "Picture2"'s on the same sheet?) Is there a way to tell this to delete the picture in the upper left corner? Or is there a way to change the name of the other picture to "Picture 20" or something else? I would have to do that manually.

 

[VoG]

Are you sure? As far as I know you can only have one "Picture 2" on a worksheet. Could the other one be "Picture2" or similar?

 

[PCTech]

I have taken care of the previous issue. Now can someone tell me why this line does not work in my code.

 If ws.Shapes("Picture 2").exist Then

It acts like Picture 2 is on every sheet.

Sub MarquisLogo()
Dim vs As Worksheet
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
    If ws.Shapes("Picture 2").exist Then
    ws.Shapes("Picture 2").Delete
    ws.Pictures.Insert ("Y:\Work Files\PRICE GUIDE\marquispb.jpg")
    With ws.Shapes(ws.Shapes.Count)
        .Top = ws.Range("A1").Top
        .Left = ws.Range("A1").Left
        .LockAspectRatio = msoFalse
        .Height = 114#
        .Width = 222.75
    End With
    Else
    End If
Next ws
End Sub

 

[PCTech]

I found a way to make it work.

Sub MarquisLogo()
Dim vs As Worksheet
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
    For i = 1 To ws.Shapes.Count
    If ws.Shapes(i).Name = "Picture 2" Then
        ws.Shapes(i).Delete
        ws.Pictures.Insert ("Y:\Work Files\PRICE GUIDE\marquispb.jpg")
    With ws.Shapes(ws.Shapes.Count)
        .Top = ws.Range("A1").Top
        .Left = ws.Range("A1").Left
        .LockAspectRatio = msoFalse
        .Height = 114#
        .Width = 222.75
    End With
    Else
    End If
Next i
Next ws
End Sub