TPE

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

Sub ExpandSlide()

' Enable the error handler.
On Error GoTo ErrorHandler

Dim oShape As Shape
Dim i As Long
Dim oSlide As Slide
Dim strTitle As String
Dim lStrLen As Long
Dim lParas As Long
Dim lCurrIndex As Long
Dim lLastSlide As Long
Dim ErrMsg As String

' Check to see if the presentation is in the correct view.
' Raise the custom error message 555.
'
If ActiveWindow.ViewType <> ppViewNormal And ActiveWindow.ViewType _
<> ppViewSlide Then
Err.Raise 555, "Expand Slide Macro", _
"Not in Slide View or Normal View"
End If

With ActiveWindow.Selection
' Set lCurrIndex to the current slide index.
' Set lLastslide to the current slide index.
'
lCurrIndex = .SlideRange.SlideIndex
lLastSlide = lCurrIndex

' Check each shape of the current slide; check to
' see if it is a Body placeholder.
'
For Each oShape In .SlideRange.Shapes
If oShape.PlaceholderFormat.Type = ppPlaceholderBody Then

' Set lParas to the number of paragraphs in the
' Body placeholder. Does not differentiate between
' first level bullets and lower level bullets.
'
lParas = oShape.TextFrame.TextRange.Paragraphs.Count

For i = 1 To lParas

' Set strTitle to the current paragraph index.
'
strTitle = oShape.TextFrame.TextRange.Paragraphs(i).Text

' Determine how long the string is. Then, as long as
' it is not the last parapgraph in the Body placeholder,
' strip off the last two characters, the line feed and
' carriage return.
'
lStrLen = Len(strTitle)
If lParas <> i Then
strTitle = Left(strTitle, lStrLen - 2)
End If

' Set lLastSlide to the next available index position.
' Create a news slide, with the Bulleted Text layout.
' Assign the text from the current paragraph to the
' title placeholder. Return to the original slide.
'
lLastSlide = lLastSlide + 1
Set oSlide = _
ActivePresentation.Slides.Add(lLastSlide, ppLayoutText)
oSlide.Shapes(1).TextFrame.TextRange.Text = strTitle
ActiveWindow.View.GotoSlide (lCurrIndex)
Next i
End If
Next
End With
Exit Sub
ErrorHandler:
' Create Error message and raise dialog with error message.
'
ErrMsg = "Error:" & Err.Source & vbNewLine & Err.Description
MsgBox ErrMsg, vbCritical, "Error Message"
End Sub