VideoPhoto

20 January, 2022

Animation - Flying Objects

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.

 

 

No comments:

Post a Comment

All comments are held for moderation. I reserve the right to edit, censor, delete and - if necessary - block comments.