How to copy a picture from one shape to another

[ACommandLineKindaGuy]

I would like to replace 45 icons looping n = 1 to 45
using Worksheets("Print Label").Shapes.Range(Array("Icon " & n))
with another picture Worksheets("Print Label").Shapes.Range(Array("Choice"))

I tried using the macro recorder to copy the selected shape and then right-click on the shape to be pasted, selected change picture, and selected from clipboard. But none of that was captured by the recorder

Can anyone help?

TIA John

 

[lrobbo314]

From rooting around the internet, it doesn't seem like you can change the picture. But, the code below will delete all of your icon shapes and replace it with a picture from somewhere on your computer stored in the PicPath variable. Let me know if this does what you are looking for.

Sub shps()
Dim ws As Worksheet: Set ws = Sheets("Print Label")
Dim PicPath As String: PicPath = "C:\Users\UserName\Pictures\YourPicture.png"
Dim shp As Object


For Each shp In ws.DrawingObjects
    If shp.Name Like "Icon [0-9]" Then
        With Pictures.Insert(PicPath)
            .Height = shp.Height
            .Width = shp.Width
            .Top = shp.Top
            .Left = shp.Left
        End With
        shp.Delete
    End If
Next shp


End Sub

 

[Domenic]

Hi lrobbo314,

Just wanted to point out that you forgot to qualify your reference...

With [COLOR=#ff0000]ws.[/COLOR]Pictures.Insert(PicPath)

Cheers!

 

[Domenic]

Here's another way...

    Dim n As Long    
    With Worksheets("Print Label")
        .Shapes("Choice").PickUp
        For n = 1 To 45
            .Shapes("Icon " & n).Apply
        Next n
    End With

However, this method will also copy any other formatting that you may have applied to Choice.

Hope this helps!

 

[ACommandLineKindaGuy]

I like not having to copy an image file, but the pickup/apply method doesn't work--it only copies the formatting, not the image itself.

Any other ideas?

 

[Domenic]

Sorry, I thought we were dealing with shapes (ie. circle, rectangle, et.). I guess this is not the case, correct?

 

[Kenneth Hobson]

Is the TypeName() for each of the shapes "Picture"? You can test each by selecting them and running:

Msgbox typename(Selection)

 

[ACommandLineKindaGuy]

Domenic--yes that's correct. They are images.

Kenneth--yes typename is Picture

 

[lrobbo314]

How about this?

Sub shps()
Dim ws As Worksheet: Set ws = Sheets("Print Label")
Dim rep As Object: Set rep = ws.Shapes.Range(Array("Choice"))
Dim shp As Object

rep.Copy

For Each shp In ws.DrawingObjects
    If shp.Name Like "Icon [0-9]" Then
        ws.Pictures.Paste.Select
        With Selection
            .Height = shp.Height
            .Width = shp.Width
            .Top = shp.Top
            .Left = shp.Left
        End With
        shp.Delete
    End If
Next shp

End Sub

 

[ACommandLineKindaGuy]

Afraid not. rep.Copy generates a 438 Object doesn't support this property or method