Animating Your Company’s Logo in Excel
Posted by: Craig Hatmaker
This post shows how to animate a logo in Excel using VBA. (Click here to download code)
[kml_flashembed movie="http://www.youtube.com/v/97tZL3TJhWs" width="480" height="292" wmode="transparent" /]Logos are an easy way to add a sense of professionalism to your work. Splash screens and logos are part of every software product purchased and should be part of every application you provide you customers. Besides, animating logos is fun. It entertains users and sets your work apart from the average Excel programmer. I use them when the workbook first opens. Here’s how it’s done.
Open a blank workbook. Rename the first tab “Data”. This will be the worksheet displayed when our workbook opens. Now get a copy of your company’s logo. Your company’s website probably has one about the right size. Paste it onto the Data worksheet. We need to name it “Logo”. To do that, select it, then use Alt-F11 to get to the Visual Basic Editor. Use Ctrl-G to display the Immediate Window. Type “Selection.Name = “Logo” and hit enter. Now we’re ready to code.
Use Ctrl-R to bring up the Project Explorer. Double click “ThisWorkBook.” That brings up the workbook’s code window. Our first routine must run when the workbook opens so we will code it in the Workbook_Open event. This routine activates the worksheet we renamed “Data”, and passes our “Logo” shape to two routines. The first “Grows” the logo into view. The second spins it once.
Private Sub Workbook_Open() Worksheets("Data").Activate ActiveSheet.Shapes("Logo").LockAspectRatio = False GrowShape ActiveSheet.Shapes("Logo"), 10 SpinShape ActiveSheet.Shapes("Logo"), 10 End Sub
The “Grow” routine expands any shape into view. It first turns off screen updating. This allows us to make changes behind the scenes and display the results when we’re ready. Next, the routine remembers the shape’s dimensions. Then the routine changes the shape’s size, displays it, freezes the screen, and loops back until finished. Before returning, the Grow routine makes sure the shape is exactly as we found it.
The Spin routine is nearly identical. It freezes the screen, remembers the shape’s original dimensions, then alters the shapes size in a loop that simulates the shape spinning around its Y axis. When finished, the routine restores the shape to its original size.
That’s all there is to animating a logo.
Function GrowShape(ByRef Shape As Shape, Step As Integer) As Boolean
' Description:Expands a shape into view
' Parameters: Shape 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
' Date Init Modification
' 01/10/11 CWH Initial Programming
Dim lCenterX As Long 'Shape's center X coordinate Dim lCenterY As Long 'Shape's center Y coordiante Dim lWidth As Long 'Shape's width Dim lHeight As Long 'Shape's height Dim l As Long 'Generic Counter for the loop Application.ScreenUpdating = False With Shape 'Remember shape's original dimensions lCenterX = .Width / 2 + .Left lCenterY = .Height / 2 + .Top lWidth = .Width lHeight = .Height 'Animation Loop For l = 0 To lWidth Step Step .Width = l .Height = l * lHeight / lWidth .Left = lCenterX - .Width / 2 .Top = lCenterY - .Height / 2 Shape.Visible = True Application.ScreenUpdating = True Application.ScreenUpdating = False Next l 'Restore shape's original dimensions .Width = lWidth .Height = lHeight .Left = lCenterX - .Width / 2 .Top = lCenterY - .Height / 2 End With Application.ScreenUpdating = True
End Function
Function SpinShape(ByRef Shape As Shape, Step As Integer) As Boolean
' Description:Expands a shape into view
' Parameters: Shape The shape to animate
' Step Larger #s animate faster
' Steps should divide 90 evenly
' Example: SpinShape ActiveSheet.Shapes("Logo"), 10
' Date Init Modification ' 01/10/11 CWH Initial Programming Const Pi = 3.14159265358979 Dim sng01 As Single '1 Degree in Radians sng01 = Pi / 180 Dim lCenterX As Long 'Shape's center X coordinate Dim lCenterY As Long 'Shape's center Y coordiante Dim lWidth As Long 'Shape's width Dim lHeight As Long 'Shape's height Dim l As Long 'Generic Counter for the loop Application.ScreenUpdating = False With Shape .LockAspectRatio = False 'Remember shape's original dimensions lCenterX = .Width / 2 + .Left lCenterY = .Height / 2 + .Top lWidth = .Width lHeight = .Height 'Animation Loop For l = 0 To 360 Step Step .Width = lWidth * Abs(Cos(l * sng01)) .Left = lCenterX - .Width / 2 If l = 90 Or l = 270 Then .Flip msoFlipHorizontal Shape.Visible = True Application.ScreenUpdating = True Application.ScreenUpdating = False Next l 'Restore shape's original dimensions .Width = lWidth .Height = lHeight .Left = lCenterX - .Width / 2 .Top = lCenterY - .Height / 2 End With Application.ScreenUpdating = True
End Function




