Sub to replace pictures in a workbook

[Guest]

Hi guys,

I'm looking for help with a sub to replace pictures within a workbook.

I've inserted and positioned say: Picture 1
in several places within Sheet1, and also within Sheet2, Sheet3, etc

Now I've just inserted say: Picture 5 somewhere within Sheet1

I would like to run a sub to replace Picture 1 with Picture 5
everywhere within the book.

The sub should return me to Sheet1 upon completion.

Thanks.

---

 

[Guest]

Any insights, folks?

"Picture 1" and "Picture 5" are the names of the inserted pictures
that I see in the namebox

---

 

[Dave Peterson]

This may give you a start...

Option Explicit
Sub testme()
Dim myMstrPict As Picture
Dim myPict As Picture
Dim myNewPict As Picture
Dim wks As Worksheet
Dim myTop As Double
Dim myWidth As Double
Dim myHeight As Double
Dim myLeft As Double
Dim myReplacementName As String

myReplacementName = "Picture 1"
Set myMstrPict = Worksheets("sheet1").Pictures("Picture 5")

For Each wks In ActiveWorkbook.Worksheets
If wks.Name = myMstrPict.Parent.Name Then
'do nothing on that master sheet
Else
For Each myPict In wks.Pictures
With myPict
If LCase(.Name) = LCase(myReplacementName) Then
'found one
myTop = .Top
myWidth = .Width
myLeft = .Left
myHeight = .Height
.Delete
myMstrPict.Copy
.Parent.Paste
Set myNewPict = .Parent.Pictures(.Parent.Pictures.Count)
With myNewPict
.Top = myTop
.Width = myWidth
.Left = myLeft
.Height = myHeight
.Name = myMstrPict.Name
End With
End If
End With
Next myPict
End If
Next wks
End Sub

 

[Guest]

This may give you a start...

Many thanks, Dave!

I've tested here carefully a couple of times.

My test set-up (sheets placed from left to right):
Sheet1: 1 instance of Picture 5

Sheet4: 1 instance of Picture 1
Sheet5: 2 instances of Picture 1
Sheet7: 3 instances of Picture 1
Sheet9: 1 instance of Picture 1

(Names: "Picture 5", "Picture 1" were ensured correct on all sheets)

Ran the sub to replace Picture 1 with Picture 5,
but hit an error (see below)

Results were:
Sheet4: 1 instance of Picture 1 (OK, replaced with Pic 5, beautiful!)
Sheet5: 2 instances of Picture 1 (Not OK, replaced only 1 instance with Pic 5)
Sheet7: 3 instances of Picture 1 (Untouched, nothing done)
Sheet9: 1 instance of Picture 1 (Untouched, nothing done)

Error msg: Runtime error 1004
Unable to get the Name property of the Picture class

Debug pointed at this line:
If LCase(.Name) = LCase(myReplacementName) Then

Thanks
(btw, i'm now using XL 2003 <g>)

---

 

[Dave Peterson]

My bet is you got the 1004 error on the 2nd picture of sheet5. So sheet7 and
sheet9 didn't get looked at.

I think the real bad news is that when you have multiple pictures with the same
name on the same worksheet, then when you use code like:

activesheet.pictures("picture 1").delete

You can never be sure what picture is being deleted. (It's come up in other
responses.)

And same with setting the position (.height, .width, .top, .left). (All this is
with "If I recall correctly" added to it!)

I think the best solution was/is to make sure that there aren't pictures with
the same name on the same sheet.

 

[Guest]

I think the best solution was/is to make sure that there aren't pictures with
the same name on the same sheet.

Thanks for insights, Dave !

If supposing I were to ensure the above, whilst retaining a meaningful, say,
alphanumeric sequence of naming the picture instances for ease of future
replacements' sake, for example, I label the pic instances as: Picture 1,
Picture 1a, Picture 1b, etc (same pic in same sheet, just different names)

and then when I want to replace all of Picture 1*
with a new pic: Picture 5,
with the pics replaced renamed in the same manner:
Picture 5, Picture 5a, Picture 5b, etc

would the above then make it possible via a sub ?

I definitely wouldn't mind the one-time labour of naming pics carefully if
this allows a sub to be run for eventual replacements. Thanks for further
thoughts.

---

 

[Dave Peterson]

I think I'd use names like: picture_001_A

It might make it a bit easier.

Option Explicit
Sub testme()
Dim myMstrPict As Picture
Dim myPict As Picture
Dim myNewPict As Picture
Dim wks As Worksheet
Dim myTop As Double
Dim myWidth As Double
Dim myHeight As Double
Dim myLeft As Double
Dim myName As String
Dim PrefixToUse As String
Dim PrefixToLookFor As String

PrefixToLookFor = "Picture_005"
PrefixToUse = "Picture_001"

'use whatever name you want for the replacement
Set myMstrPict = Worksheets("sheet1").Pictures("picture_001")

For Each wks In ActiveWorkbook.Worksheets
If wks.Name = myMstrPict.Parent.Name Then
'do nothing on that master sheet
Else
For Each myPict In wks.Pictures
With myPict
If LCase(.Name) Like LCase(PrefixToLookFor) & "*" Then
'found one
myTop = .Top
myWidth = .Width
myLeft = .Left
myHeight = .Height
myName = .Name
.Delete
myMstrPict.Copy
.Parent.Paste
Set myNewPict = .Parent.Pictures(.Parent.Pictures.Count)
With myNewPict
.Top = myTop
.Width = myWidth
.Left = myLeft
.Height = myHeight
.Name = Replace(expression:=myName, _
Find:=PrefixToLookFor, _
Replace:=PrefixToUse, _
Start:=1, Count:=-1, _
compare:=vbTextCompare)
End With
End If
End With
Next myPict
End If
Next wks
End Sub


(I think it does what you want???)

 

[Guest]

I think I'd use names like: picture_001_A
It might make it a bit easier.

(I think it does what you want???)

Based on my tests here so far, it's, it's ... excellent !
(switched the 005 and 001 bits around though <g>)

Many thanks, Dave for your help !

---

 

[Dave Peterson]

It was late and I was tired and confused.

(There might be a lesson in there somewhere--but it's early and I'm tired and
confused <vbg>.)