Placering af billeder vha. makro

Her lidt inspiration:

Sub Billeder()

If MsgBox("Ændre billed-navne til 1,2,3... ok ? ", vbYesNo) = vbYes Then
For t = 1 To ActiveSheet.Shapes.Count
ActiveSheet.Shapes(t).Name = t ' Resetter billednavne til 1,2,3,4....
Next
End If

For t = 1 To ActiveSheet.Shapes.Count
x = x & ActiveSheet.Shapes(t).Name & Chr(13)
Next
MsgBox ("") & x


ActiveSheet.Shapes(1).Copy ' kopier billede 1
ActiveSheet.Paste Destination:=ActiveSheet.Cells(8, 4) ' indsæt kopi ved selle D8


ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Select ' aktiver sidste billede
For t = 1 To 8 ' zoom op
Selection.ShapeRange.ScaleWidth 1.1, msoFalse, msoScaleFromTopLeft ' værdi >1 zoomer op
Selection.ShapeRange.ScaleHeight 1.1, msoFalse, msoScaleFromTopLeft
Application.Wait (Now + TimeValue("0:00:1"))
Next
'MsgBox ("")
For t = 1 To 8 ' zoom ned
Selection.ShapeRange.ScaleWidth 0.9, msoFalse, msoScaleFromTopLeft ' værdi <1 zoomer ned
Selection.ShapeRange.ScaleHeight 0.9, msoFalse, msoScaleFromTopLeft
Application.Wait (Now + TimeValue("0:00:1"))
Next
For t = 1 To 12 ' flyt til venstre og ned
Selection.ShapeRange.IncrementLeft -t * 2
Selection.ShapeRange.IncrementTop t * 2
Application.Wait (Now + TimeValue("0:00:1"))
Next

End Sub

Tak for inspiration ...

Men kan jeg ikke navngive billederne ved indsættelsen, jeg vil gerne have dem flyttet på plads med det samme ...

Hvis jeg omdøber billederne hvilket får så hvilket nummer ... og hvad med andre billeder ...?

Søren

du kan navngi billede lige efter det er insat med

Selection.Name = " navn "

Tak ... det vist nok for den 60 øre ...

Regnere med at du parat med et svar ...

anytime :-)

*