VBA Excel presentations

Ever wonder how can be performed an animation of a shape in Excel as it’s easily done in PowerPoint?

Following code comes from BeyondExcel site, an excepcional place to learn new Excel tricks. Basically it performs the strech grow and spin effects for any shape, very cute. From here on, any other effects are easily achievable (show from direction, fade,…).

Public Sub Workbook_Open()
' Description:Runs when workbook opens

Dim n As Integer
Dim oShp As Excel.Shape

'Worksheets("Data").Activate
Set oShp = ActiveSheet.Shapes(1) 'Selection.ShapeRange.Item(1)
ActiveSheet.Range("A1").Select
oShp.LockAspectRatio = False
n = 5
#If VBA7 Then
n = 10 'is way faster
#End If
GrowShape oShp, n
SpinShape oShp, n

End Sub

Public Function SpinShape(ByRef oShp As Excel.Shape, _
ByRef Step As Integer) As Boolean
' Description:Expands a shape into view

' Parameters: oShp The shape to animate
' Step Larger #s animate faster
' Steps should divide 90 evenly

' Example: SpinShape ActiveSheet.Shapes("Logo"), 10

Const PI As Double = 3.14159265358979

Dim sng01 As Single: sng01 = PI / 180 '1 Degree in Radians

Dim sgCenterX As Single 'Shape's center X coordinate
Dim sgCenterY As Single 'Shape's center Y coordiante
Dim sgWidth As Single 'Shape's width
Dim sgHeight As Single 'Shape's height
Dim lgRotate As Long 'Generic Counter for the loop

With oShp
.LockAspectRatio = False
'Remember shape's original dimensions
sgCenterX = .Width / 2 + .Left
sgCenterY = .Height / 2 + .Top
sgWidth = .Width
sgHeight = .Height
.Visible = True
'Animation Loop
For lgRotate = 0 To 360 Step Step
.Width = sgWidth * Abs(Cos(lgRotate * sng01))
.Left = sgCenterX - .Width / 2
If lgRotate = 90 Or lgRotate = 270 Then .Flip msoFlipHorizontal
DoEvents
Next lgRotate
'Restore shape's original dimensions
.Width = sgWidth
.Height = sgHeight
.Left = sgCenterX - .Width / 2
.Top = sgCenterY - .Height / 2
End With

End Function

Public Function GrowShape(ByRef oShp As Excel.Shape, _
ByRef Step As Integer) As Boolean
' Description:Expands a shape into view

' Parameters: oShp The shape to animate
' Step Larger #s animate faster

' Example: GrowShape ActiveSheet.Shapes("Logo"), 10

' Note: For best results, shape should be hidden before calling this routine

Dim sgCenterX As Single 'Shape's center X coordinate
Dim sgCenterY As Single 'Shape's center Y coordiante
Dim sgWidth As Single 'Shape's width
Dim sgHeight As Single 'Shape's height
Dim lgAngle As Long 'Generic Counter for the loop

With oShp
' Remember shape's original dimensions
sgCenterX = .Width / 2 + .Left
sgCenterY = .Height / 2 + .Top
sgWidth = .Width
sgHeight = .Height
.Visible = True
' Animation Loop
For lgAngle = 0 To VBA.CLng(sgWidth) Step Step
.Width = lgAngle
.Height = lgAngle * sgHeight / sgWidth
.Left = sgCenterX - .Width / 2
.Top = sgCenterY - .Height / 2
DoEvents
Next lgAngle
' Restore shape's original dimensions
.Width = sgWidth
.Height = sgHeight
.Left = sgCenterX - .Width / 2
.Top = sgCenterY - .Height / 2
End With
End Function

[/sourcecode]

Leave a Reply

Your email address will not be published. Required fields are marked *