Make sure that text fits slides, adding new slides as needed for "overflow"

Problem

You have lots of text on slides, perhaps in a show that's been generated automatically from an external source of text. You want to make sure that no one slide has more text than will fit comfortably on it. You need to add new slides as necessary to contain the "overflow" text.

Solution

This macro by PowerPoint MVP Bill Dilworth will do the job for you. I'll hand the microphone over to Bill to explain it:

I wrote this macro for this exact same reason. It will go thru your slides and move any text over a limit you set to a new slide. There are a couple of things to keep the macro easy:

1. It only evaluates the number of lines, not the size of the text.
2. The text must be in the 'Click to add text' placeholder.
3. It evaluates each slide in the entire presentation, not just one or two selected ones.

Cut and paste this whole ugly mess into the VBE and run the macro on a copy of your presentation. If you need any additional help with this, post on the PowerPoint newsgroup. We're here to help.

Here's Bill's code [ed: with a few mods so it handles slides w/ no second placeholder etc.]:

Sub WrapOver()

    Dim SldCnt As Long
    Dim SldNum As Long
    Dim WrapCnt As Long
    Dim OldCnt As Long

    SldCnt = ActivePresentation.Slides.Count
    OldCnt = SldCnt

    WrapCnt = InputBox("'Wrap' text in placeholder " & _
        "if they exceed how many lines?", "Wrap after" & _
        "input", "6")

    If WrapCnt > 15 Or WrapCnt < 2 Then
        MsgBox "Please enter a number between 2 and 15" & _
        ", when you re-run this macro", vbCritical + _
        vbOKOnly, "Input range error"
        Exit Sub
    End If

    SldNum = 0
    With ActivePresentation

NextSlide:
        SldNum = SldNum + 1
        If SldNum > SldCnt Then
            GoTo EndRoutine
        End If

        ' Ignore slides with no second placeholder shape
        On Error Resume Next
        If .Slides(SldNum).Shapes.Placeholders(2) _
            .TextFrame.TextRange.Lines _
            .Count <= WrapCnt Then
                GoTo NextSlide
        End If
        On Error GoTo ErrorHandler

        .Slides(SldNum).Duplicate
        SldCnt = SldCnt + 1
        With .Slides(SldNum).Shapes.Placeholders(2).TextFrame.TextRange
            .Lines(WrapCnt + 1, .Lines.Count).Delete
        End With
        .Slides(SldNum + 1).Shapes.Placeholders(2) _
            .TextFrame.TextRange.Lines(1, WrapCnt).Delete
        GoTo NextSlide

EndRoutine:
        End With
        MsgBox "Task complete.  " & SldCnt - OldCnt & _
            " slides were added.", vbOKOnly, WrapCnt & _
            " line max. macro"

NormalExit:
    Exit Sub
ErrorHandler:
    Resume NormalExit

End Sub

Search terms:overflow,text,spill,spillover,new,slide,extra

---