Move and size a object on the sheet

[Riddler]

I have a simple macro that copies a picture object called "Pumpkin"
onto a sheet. My problem is that I would like to move the upper left
corner of the picture to the upper left corner of cell 5,5. The
problem I am having is how do I reference the "Pumpkin" picture that
was just put on the sheet? I have many other pumpkin pictures on the
sheet already so using the name "Pumpkin" is not possible. It also
does not appear to be active right after the ActiveSheet.Paste that
puts it on the sheet.
Can you help with how I can reference this picture object just pasted
on the sheet with a name that is the same as many others already on
the sheet?

Thanks
Scott

Sub Macro4()
Sheets("Sheet1").Shapes("Pumpkin").Copy
ActiveSheet.Paste Destination:=Worksheets("Test
Traveler").Cells(5, 5)
End Sub

 

[Guest]

hi
i think it is possible to do what you want
i have a code that takes all pictures in a sheet and organised them in a
certain order on the sheet
the code is below, i hope it will help you, good luck anyway

eaxample one:
Public Sub EQCclearpicture()
Dim x As Shape
On Error GoTo myexit
Application.DisplayAlerts = False
For Each x In ActiveSheet.Shapes
If x.Type = msoPicture Then x.delete
Next x
myexit:
Application.DisplayAlerts = True
End Sub

example 2:
Public Sub EQCorganisegraphs(Optional fittoone As Boolean = False, Optional
howmanyperrow As Integer = 1)
Dim x As Shape
Dim count, nexttop, nextleft As Integer
Dim perrow As Integer
Dim locd As Double
Dim width, height As Integer
width = 0
height = 0
perrow = 0
count = 0
nexttop = 0
nextleft = 0
For Each x In ActiveSheet.Shapes
If x.Type = msoPicture Then count = count + 1
Next x
If count = 0 Then Exit Sub
If fittoone Then
width = CInt(ActiveWindow.UsableWidth / howmanyperrow)
height = CInt(ActiveWindow.UsableHeight / (CInt(count /
howmanyperrow) + 1))
'width = CInt(ActiveWindow.width / howmanyperrow)
'height = CInt(ActiveWindow.height / (CInt(count / howmanyperrow) +
1))
End If
Application.ScreenUpdating = False
For Each x In ActiveSheet.Shapes
If x.Type = msoPicture Then
If fittoone = False Then
x.top = nexttop
x.left = 0
nexttop = nexttop + x.height
End If
If fittoone Then
x.top = nexttop
x.left = nextleft
x.ScaleHeight height / x.height, msoFalse, msoScaleFromTopLeft
x.ScaleWidth width / x.width, msoFalse, msoScaleFromTopLeft
' x.height = height
' x.width = width
If perrow + 1 = howmanyperrow Then
perrow = 0
nextleft = 0
nexttop = nexttop + height
Else
perrow = perrow + 1
nextleft = nextleft + width
End If
End If
End If
Next x
Application.ScreenUpdating = True
End Sub