Make sure that text fits slides, adding new slides as needed for "overflow"
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.
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:
- It only evaluates the number of lines, not the size of the text.
- The text must be in the 'Click to add text' placeholder.
- 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