Search code examples
vbapowerpoint-2010

How to split the content placeholder line by line into a text shape powerpoint 2010


I am new to vb and power point , trying to run a macro in power point 2010. What i am trying to achieve is, when the macros is run, it should split the contents in the content placeholder area line by line, and placing each line in a new text box shape.

I had done some work, but not able to move forward. The macro function is below

Sub HelloWorldMacro()

Dim Sld As Slide
Dim Shp As Shape
' Current slide
Set Sld = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideIndex)

For Each s In Sld.Shapes
    ' Condition - not to grab contents from title area.
    If s.Name <> "Title 1" Then
        If s.HasTextFrame Then
            With s.TextFrame
                If .HasText Then MsgBox .TextRange.Text
            End With
        End If
    End If
Next
End Sub 

With this i been able to grab the text from content area into a msg box. But not able to split it and place it in a text shape area.

Also done tried some shape create function, but not able to combine these.

Sub create_shape()

Dim Sld As Slide
Dim Shp As Shape

Set Sld = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideIndex)

Set Shp = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
    Left:=24, Top:=65.6, Width:=672, Height:=26.6)

    Shp.Name = "My Header"
    Shp.Line.Visible = msoFalse
    Shp.Fill.ForeColor.RGB = RGB(184, 59, 29)
End Sub

Solution

  • This shows you how to get each line or paragraph in a text box:

    Sub LineByLine()
        Dim oSh As Shape
        Dim x As Long
        ' for example only:
        Set oSh = ActiveWindow.Selection.ShapeRange(1)
    
        With oSh.TextFrame.TextRange
            For x = 1 To .Paragraphs.Count
                MsgBox .Paragraphs(x).Text
            Next
            For x = 1 To .Lines.Count
                MsgBox .Lines(x).Text
            Next
        End With
    End Sub