Split a text box into two text boxes on the same slide

[nawolf06]

Hey guys! I would like to do 2 thing:

1. I would like to create a VBA command button to split text within a text box into two. So basically I need a split where my cursor is currently at within the text into two text boxes on the same slide (ideally the second text box created is placed under the first text box).

2. Combine two or more text boxes into one text box

Any help would be highly appreciated!
Thank you!

[John Wilson]

Here's the problem with your plan ...

Code to do this will only work in edit mode
Command buttons will NOT work in edit mode.

[nawolf06]

So then would that be possible to split the textbox based on paragraph then?

e.g.
"dskfnkdsfskldjfl
kjsdnfksdnfksdnf

skdlfkldsjf
ksldfklsdfjsdlkjf"

and split into two text boxes

Here's the problem with your plan ...

Code to do this will only work in edit mode
Command buttons will NOT work in edit mode.

[StarPig]

These might be useful:

The first splits a text box by the existing bullets (or paragraph return) - so each bullet has its own text box with a pre-set width in the code (currently 500).

The second one merges selected text boxes into one text box, but all become the first bullet level (currently WingDings 108).

TO SPLIT

Sub Split()
    Dim oshp As Shape
    Dim oSld As Slide
    Dim l As Long
    Dim otr As TextRange2
    Dim x As Integer
    Set oshp = ActiveWindow.Selection.ShapeRange(1)
    Set oSld = oshp.Parent
    If oshp.HasTextFrame Then
        If oshp.TextFrame2.HasText Then
            With oshp.TextFrame2.TextRange
                For l = 1 To .Paragraphs.Count
                    Set otr = .Paragraphs(l)
                    With oSld.Shapes.AddTextbox(msoTextOrientationHorizontal, oshp.Left, oshp.Top + x, 500, 0)
                        .TextFrame2.AutoSize = msoAutoSizeShapeToFitText
                        .TextFrame2.VerticalAnchor = msoAnchorTop
                        .TextFrame2.MarginBottom = 0
                        .TextFrame2.MarginTop = 0
                        With .TextFrame2.TextRange
                            .Text = Replace(otr.Text, vbCr, "")
                            .Font.Bold = False
                            .ParagraphFormat.Alignment = msoAlignLeft
                            .ParagraphFormat.Bullet.Visible = True
                            .ParagraphFormat.Bullet.Character = 108
                            .ParagraphFormat.Bullet.Font.Name = "WingDings"
                            .ParagraphFormat.Bullet.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
                            .ParagraphFormat.LeftIndent = 14.3
                            .ParagraphFormat.FirstLineIndent = -14.3
                        End With
                        x = x + .Height
                    End With
                Next l
            End With
        End If
    End If
    oshp.Delete
    Exit Sub
End Sub

TO MERGE

Sub Merge()
    Dim oRng As ShapeRange
    Dim oFirstShape As Shape
    Dim oSh As Shape
    Dim x As Long
    Set oRng = ActiveWindow.Selection.ShapeRange
    Set oFirstShape = oRng(1)
    oFirstShape.TextFrame.TextRange.Text = _
    oFirstShape.TextFrame.TextRange.Text & vbCrLf
    For x = 2 To oRng.Count
        oFirstShape.TextFrame.TextRange.Text = _
        oFirstShape.TextFrame.TextRange.Text _
        & oRng(x).TextFrame.TextRange.Text
        If x < oRng.Count Then
            oFirstShape.TextFrame.TextRange.Text = _
            oFirstShape.TextFrame.TextRange.Text _
            & vbCrLf
        End If
    Next
    For x = oRng.Count To 2 Step -1
        oRng(x).Delete
    Next
    Set oRng = Nothing
    Set oFirstShape = Nothing
    Set oSh = Nothing
    Exit Sub
End Sub