Excel

Animated Word Art

Ease of Use

Easy

Version tested with

2000, 2003 

Submitted by:

Brandtrock

Description:

WordArt in an Excel spreadsheet can be animated to a certain extent. This example illustrates how to twist the letters back and forth and how to spin the WordArt like an airplane propellor. 

Discussion:

The animation of a WordArt object in a spreadsheet can make quite an impression on co-workers or clients. No real functionality is added, this is purely bells and whistles stuff. 

Code:

instructions for use 

			
 '********************
 '* Code for Module1
 '********************
 
 
Option Explicit 
Dim oldcell As Range 
Dim m As Variant 
Dim i As Variant 
 
 
 
Sub StartDemo() 
     'Thanks to John Walkenbach for illustrating how to do this
    On Error Resume Next 
    Set oldcell = ActiveCell 
     
     'twist Word Art 1
    ActiveSheet.Shapes("WordArt 1").Select 
    m = 1 
    For i = 1 To 80 
        Selection.ShapeRange.TextEffect.Tracking = m 
        m = m + 0.125 
        DoEvents 
    Next i 
    For i = 80 To 1 Step -1 
        Selection.ShapeRange.TextEffect.Tracking = m 
        m = m - 0.125 
        DoEvents 
    Next i 
     
    Selection.ShapeRange.TextEffect.Tracking = 1 
     
     'Spin WordArt2 text
    ActiveSheet.Shapes("WordArt 2").Select 
    For i = 1 To 8 
        Selection.ShapeRange.IncrementRotation 45# 
        DoEvents 
    Next i 
     
    Selection.ShapeRange.TextEffect.Tracking = 1 
     
     'twist WordArt2 text
    ActiveSheet.Shapes("WordArt 2").Select 
    m = 1 
    For i = 1 To 80 
        Selection.ShapeRange.TextEffect.Tracking = m 
        m = m + 0.25 
        DoEvents 
    Next i 
    For i = 80 To 1 Step -1 
        Selection.ShapeRange.TextEffect.Tracking = m 
        m = m - 0.25 
        DoEvents 
    Next i 
     
    Selection.ShapeRange.TextEffect.Tracking = 1 
     
     'spin WordArt2 text
    ActiveSheet.Shapes("WordArt 2").Select 
    For i = 1 To 16 
        Selection.ShapeRange.IncrementRotation 45# 
        DoEvents 
    Next i 
     
    Selection.ShapeRange.TextEffect.Tracking = 1 
     
    oldcell.Select 
     
End Sub 
 
 '********************
 '* Code for ThisWorkbook
 '********************
 
Option Explicit 
 
Private Sub Workbook_Open() 
    StartDemo 
End Sub

How to use:

  1. Open a worksheet.
  2. Create two WordArts of your own design.
  3. Copy the code marked Code for Module1.
  4. Press Alt + F11 to open the Visual Basic Editor (VBE).
  5. From the Menu, choose Insert-Module.
  6. Paste the code into the right-hand code window.
  7. Double-click on the ThisWorkbook module.
  8. Select Workbook from the top left drop down box.
  9. Select Workbook Open from the right drop down box.
  10. Type StartDemo between the Private Sub Workbook_Open() line and the End Sub line.
  11. Close the VBE
  12. Save the file.
  13. Close the file.
 

Test the code:

  1. To test your code, simply open the workbook you just saved (or the example file). The Workbook Open event will fire the StartDemo macro upon opening.
 

Sample File:

Moving_Word_Art_xls.zip 12.14KB 

Approved by mdmackillop


This entry has been viewed 310 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express