Change Shape to Picture and Move it Across the Screen

ReDvaNiLLa · Dec 9th 2011

I have a Macro code that pops up a shape and moves it across the screen.
I want to be able to move a picture instead of a shape.
How do I go about doing that?

Here's my code

Code

Option ExplicitPrivate Declare Sub SleepNow Lib "kernel32" _
        Alias "Sleep" _
        (ByVal dwMilliseconds As Long)
Const NUM_STEPS As Long = 20
Const SHAPE_DIAMETER As Long = 20
Sub MoveShape()
   Dim shp As Shape
   Dim asglMovements(1) As Single
   Dim n As Long
   
   Dim rngStart As Range, rngStop As Range
   
   Set rngStart = Range("A1")
   Set rngStop = Range("A15")
   
   asglMovements(0) = (rngStop.Top - rngStart.Top) / NUM_STEPS
   asglMovements(1) = (rngStop.Left - rngStart.Left) / NUM_STEPS
   
   Set shp = ActiveSheet.Shapes.AddShape(msoShapeOval, rngStart.Left, rngStart.Top, SHAPE_DIAMETER, SHAPE_DIAMETER)
   For n = 1 To NUM_STEPS
      With shp
         .Visible = msoFalse
         .Top = .Top + asglMovements(0)
         .Left = .Left + asglMovements(1)
         .Visible = msoCTrue
         SleepNow 25
      End With
      DoEvents
   Next n
End Sub

Display More

**pike** · Jan 7th 2012

Re: Change Shape to Picture and Move it Across the Screen

Hi ReDvaNiLLa
with the image in the worksheet ,just change the oject to

Code

Set shp = ActiveSheet.Shapes("Picture 1")

Change Shape to Picture and Move it Across the Screen

Participate now!

Share