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]