The following VBA (Visual Basic Application) code makes Excel shapes and some other graphics flying. In this instance I'm shooting a rocket on my worksheet across the computer screen. This shape is based on Excel graphic named "Graphic 4".
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal iMilliseconds As Long)
Sub Flyer()
Sheet1.Shapes("Graphic 4").Left = 1000 'Starting X
Sheet1.Shapes("Graphic 4").Top = 450 'Starting Y
MoveShp Sheet1.Shapes("Graphic 4"), 0!, 0!, #12:00:01 AM# 'Shape inserted
End Sub
Sub MoveShp(shp As Shape, ByVal coLeft As Single, ByVal coTop As Single, t As Date)
' Moves the shape from start to finish over the interval t
Const xch = 0.018
Const n1 As Long = 30 'Accelerate/decelerate steps
Const n2 As Long = 60 'Coast steps
Const n As Long = 2 * n1 + n2 'Total steps
Dim i As Long 'Step index
Dim stpv As Single 'Coasting, pixels/step
Dim v As Single 'Velocity at current step
Dim cLiLeft As Single, cLiTop As Single 'Left and Top num
Dim cMi As Single 'Frctn denom
Dim coLeftPr As Single, coTopPr As Single 'Previous Left and Top position
stpv = 1 / (n - n1)
With shp
coLeft = coLeft - .Left: coTop = coTop - .Top
coLeftPr = .Left: coTopPr = .Top
For i = 1 To n
Select Case i
Case 1 To n1 'Accelerate
v = stpv * (1 + Cos(xch * 180 * (1 + i / n1))) / 2
Case n1 + 1 To n - n1 'Constant velocity
v = stpv
Case Else 'Decelerate
v = stpv * (1 + Cos(xch * 180 * (1 + (n - i) / n1))) / 2
End Select
.Left = .Left + v * (coLeft - cLiLeft) / (1 - cMi)
.Top = .Top + v * (coTop - cLiTop) / (1 - cMi)
cMi = cMi + v
cLiLeft = .Left - coLeftPr: cLiTop = .Top - coTopPr
DoEvents
Sleep t * 86400000# / n
Next i
End With
End Sub
To use the code in Excel on your computer follow these steps:
- find and insert Graphic 4 shape into your worksheet (if you want to use any other Excel graphic, remember to change the shape name in the above code)
- copy the code and paste it into any module of your project (workbook)
- select the "Flyer" macro from Macros in the ribbon to run it.
If you assign the macro to the shape (by
right-clicking it and selecting "Assign Macro..." option), then just click on the shape and it will fly...
Try to run it using some other shapes/objects.