Animate Text by Line or Sentence

Powerpoint only allows you to animate by paragraph. If you need to animate by sentence this can be a hassle.

Usually people recommend having the text in separate textboxes. This doesn't really work and is difficult to line up.

Another approach is to make cover shapes that fit each part you want to reveal and apply an exit animation. This can look good but is painstaking to make!

This code tries to make the shapes and animation for you. It may not always do a perfect job but it will get you close. Code is for Windows versions from 2007. NOTE you may have to edit the cover shapes a little!

Sub cover_text()
Dim L As Long
Dim P As Long
Dim S As Long
Dim oshp As Shape
Dim osld As Slide
Dim ocover As Shape
Dim oeff As Effect
Dim b_Line As Boolean
Dim adjBull As Single
Dim otr_all As TextRange2
Dim otr_sen As TextRange2
Dim otr As TextRange2
Dim oline As TextRange2
Dim space_adj As Long
Dim space_adj2 As Long
On Error Resume Next
Set oshp = ActiveWindow.Selection.ShapeRange(1)
If oshp Is Nothing Then
MsgBox "Select the text shape!"
Err.Clear
Exit Sub
End If
If oshp.HasTextFrame Then
Set otr_all = oshp.TextFrame2.TextRange
Else
Exit Sub
End If
Set osld = oshp.Parent
Call zapper
For P = 1 To otr_all.Paragraphs.Count
adjBull = otr_all.Paragraphs(P).ParagraphFormat.LeftIndent
For S = 1 To otr_all.Paragraphs(P).Sentences.Count
b_Line = True
Set otr_sen = otr_all.Paragraphs(P).Sentences(S)
If otr_sen.Characters(otr_sen.Length) = " " Then space_adj = 1 Else space_adj = 0
If otr_sen.Characters(1) = " " Then space_adj2 = 1 Else space_adj2 = 0
Set otr_sen = otr_all.Characters(otr_all.Paragraphs(P).Sentences(S).Start + space_adj2, otr_all.Paragraphs(P).Sentences(S).Length - space_adj)
Debug.Print otr_sen

For L = 1 To otr_sen.Lines.Count
Set oline = otr_sen.Lines(L)

Set ocover = osld.Shapes.AddShape(msoShapeRectangle, oline.BoundLeft - (adjBull), _
oline.BoundTop, oline.BoundWidth + adjBull, oline.BoundHeight)

ocover.Line.Visible = False
ocover.Fill.Background
ocover.Tags.Add "COVER", "YES"
adjBull = 0
If b_Line Then
Set oeff = osld.TimeLine.MainSequence.AddEffect _
(ocover, msoAnimEffectWipe, , msoAnimTriggerOnPageClick)
Else
Set oeff = osld.TimeLine.MainSequence.AddEffect _
(ocover, msoAnimEffectWipe, , msoAnimTriggerAfterPrevious)
End If
oeff.Exit = True
oeff.EffectParameters.Direction = msoAnimDirectionLeft
b_Line = False
Next L
Next S
Next P
End Sub

Sub zapper()
Dim L As Long
Dim osld As Slide
Set osld = ActiveWindow.Selection.SlideRange(1)
For L = osld.Shapes.Count To 1 Step -1
If osld.Shapes(L).Tags("COVER") = "YES" Then osld.Shapes(L).Delete
Next L
End Sub

How To Use

Press ALT f11 to open the code editor

In this dialog INSERT > Module and paste in the code.

Back in normal PPT select the shape with the text and run the macro cover_Text from VIEW > Macro. To remove the covers run zapper.