Hi John, I've updated the code and spent hours trying to fit it, but really need your expertise help please.

When a text box is selected, it converts the bullets to separate text boxes (we do this often, but our old tool has no VBA to access).

Below code currently puts the separate text boxes on the right, rather than deleting the original text box and putting the new text boxes in its place.

Plus my error message... if someone clicks the button with a text box it works fine, but the error message appears when it shouldn't. It should only appear if not text box was selected, which works fine.

Thanks in advance :



Sub SplitTextBoxes()


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
On Error GoTo err
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, 400, oshp.Top + x, 400, 15)
.TextFrame2.AutoSize = msoAutoSizeNone
.TextFrame2.VerticalAnchor = msoAnchorTop
.TextFrame2.MarginBottom = 0
.TextFrame2.MarginTop = 0
With .TextFrame2.TextRange
.Text = otr.Text
.Font.Size = 12
.Font.Bold = False
.ParagraphFormat.Alignment = msoAlignLeft
.ParagraphFormat.Bullet.visible = True
.ParagraphFormat.Bullet.Character = 167
.ParagraphFormat.Bullet.Font.Name = "WingDings"
.ParagraphFormat.Bullet.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
.ParagraphFormat.LeftIndent = 14.3
.ParagraphFormat.FirstLineIndent = -14.3
End With
End With
x = x + 20
Next L
End With
End If
End If
err:
MsgBox "Please select a text box"
End Sub