19 January, 2022

Animation - Swinging Objects

VBA (Visual Basic Application) can bring Excel to life.

In this example I'm presenting simple simulation of a swinging pendulum (Excel shape called "3D Model 8"), looking like this (in couple of positions):

 

Here is the VBA code used for creation of the pendulum effect:

Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal iMilliseconds As Long)
Sub Swing()
Do While Cells(1, 1).Value <> 2     ' Click the cell A1 to stop the macro
    Sheet1.Shapes("3D Model 8").Left = 912.132   'Starting X
    Sheet1.Shapes("3D Model 8").Top = 362.132   'Starting Y
    MoveShp Sheet1.Shapes("3D Model 8"), 0!, 0!, #12:00:01 AM#  'Call the procedure
Loop
End Sub
Sub MoveShp(shp As Shape, ByVal fLeft As Single, ByVal fTop As Single, t As Date)
'Moves the shape from original position, back & forth
    Const n As Long = 180   'Number of steps
    Const X = 700
    Const Y = 150
    Const r = 300   'Pendulum length
    Dim I As Long  'Step index
With shp
For I = 1 To n
    If I <= 0.25 * n Then
        .Left = X + r * Cos(WorksheetFunction.Radians(I + 45))
        .Top = Y + r * Sin(WorksheetFunction.Radians(I + 45))
    ElseIf I <= 0.5 * n Then
        .Left = X - r * Sin(WorksheetFunction.Radians(I - 45))
        .Top = Y + r * Cos(WorksheetFunction.Radians(I - 45))
    ElseIf I <= 0.75 * n Then
        .Left = X - r * Sin(WorksheetFunction.Radians(135 - I))
        .Top = Y + r * Cos(WorksheetFunction.Radians(135 - I))
    Else
        .Left = X + r * Sin(WorksheetFunction.Radians(I - 135))
        .Top = Y + r * Cos(WorksheetFunction.Radians(I - 135))
    End If
    If Selection.Address = "$A$1" Then End    'Clicking in cell A1 stops running the code
    DoEvents
    Sleep t * 8640000# / n
Next I
End With
End Sub

If you want to use the code and/or experiment with it, follow these steps:

  • find and insert 3D Model 8 shape (or some other, but remember to change the shape name in the above code) into your worksheet
  • copy the code and paste it into any module of your project (workbook)
  • run the "Swing" macro; it will run continuously. To stop it - click in cell A1.

By the way, you can assign the "Swing" macro to the shape, by right-clicking it and selecting "Assign Macro..." option. After that, running the macro will be as easy as clicking on the shape.

You may wish to modify the code, using different shapes and to achieve different effects. Enjoy!

 


 

No comments:

Post a Comment

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