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.