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!: pray2:
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