TPE
Tavvafi@gmail.com |
≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡
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