TPE

Tavvafi@gmail.com

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

Option Explicit

Sub AgendificateMe()

Dim X As Integer
Dim Y As Integer
Dim intParaCount As Integer
Dim oBodyText As Shape
Dim OBaseSlide As Slide
Dim oNewSlide As Slide
Dim oNewBodyText As Shape

' Note: RGB value for highlight color is hardcoded below.  Edit to suit.

Set OBaseSlide = ActiveWindow.Selection.SlideRange(1)
With OBaseSlide
    ' Get a reference to the body text placeholder
    For X = 1 To .Shapes.Placeholders.Count
        If .Shapes.Placeholders(X).PlaceholderFormat.Type = ppPlaceholderBody Then
            Set oBodyText = .Shapes.Placeholders(X)
        End If
    Next X

    ' No body text on the slide?  Squawk 'n run
    If oBodyText Is Nothing Then
        MsgBox "C'mon, WORK with me here, Karl!  I need text with BODY."
        Exit Sub
    End If

    intParaCount = oBodyText.TextFrame.TextRange.Paragraphs.Count
    For X = intParaCount To 1 Step -1
        Set oNewSlide = OBaseSlide.Duplicate(1)
        ' get a reference to the body text placeholder
        With oNewSlide
            For Y = 1 To .Shapes.Placeholders.Count
                If .Shapes.Placeholders(Y).PlaceholderFormat.Type = ppPlaceholderBody Then
                    Set oNewBodyText = .Shapes.Placeholders(Y)
                End If
            Next Y
            With oNewBodyText
                ' SET HIGHLIGHT COLOR AS DESIRED HERE:
                .TextFrame.TextRange.Paragraphs(X).Font.Color.RGB = RGB(255, 0, 0)
            End With
        End With ' oNewSlide
    Next X

End With

End Sub