Solved: Select All Pictures, And Move And Size with cells

[U_Shrestha]

Hi all,

I have a sheet with hundreds of pictures in column B2:B145 and D2:D145. Each cell in this range has a picture inserted in it. I must have the properties of each picture to be set up as "Move and size with cells" and check on "Print Object". Can someone please give me a code to do it with a macro? I would appreciate your help. Thank you.

[marshybid]

Hi there,

The code below should work for you, adjust the i = 1 to XXX to suit the number of pictures you have


Sub Move_Size()

Dim i As Long

For i = 1 To 300

On Error Resume Next
ActiveSheet.Shapes("Picture " & i).Select
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With
Next i
On Error GoTo 0

End Sub


Marshybid

[U_Shrestha]

Excellent!! The code works perfectly. Thanks Marshybid.

[obsteel]

:thumb Thanks Marshybid, saved lots of time with your code.

As a contribution i've optimized the code a little and added auto image counting :cool:.

Here is the code:

Sub Move_Size()
Dim i As Long
For i = 1 To ActiveSheet.Shapes.Count
On Error Resume Next
With ActiveSheet.Shapes.Item(i)
.Placement = xlMoveAndSize
.PrintObject = True
End With
Next i
On Error Goto 0
End Sub

[mef1sto]

Great job! Could you please tell me if i have a .msg file to upload by using
Set objI = ActiveSheet.OLEObjects.Add(Filename:=vFile(I), Link:=False, DisplayAsIcon:=True, IconFileName:="", IconIndex:=1, _ Iconlabel:=lcl_vIconLabel & Space(1) & Date & Space(1) & Time, Top:=114, Left:=541)


the problem is that after i save the file, the icon change to an envelope and the name also changes to whatever the uploaded file was named, and it doesn't save with the icon label that i prefer. Is there a way of solving this? Thanks!