Consulting

Results 1 to 3 of 3

Thread: Split a text box of bullets into one text box per bullet

  1. #1
    VBAX Contributor
    Joined
    Dec 2018
    Location
    South London
    Posts
    115
    Location

    Split a text box of bullets into one text box per bullet

    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

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    I'm back working on paying projects from today so you will see less of me!

    Try starting with:

    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, oshp.Left, oshp.Top + x, 400, 15)
    .TextFrame2.AutoSize = msoAutoSizeShapeToFitText
    .TextFrame2.VerticalAnchor = msoAnchorTop
    .TextFrame2.MarginBottom = 0
    .TextFrame2.MarginTop = 0
    With .TextFrame2.TextRange
    .Text = otr.Text
    .Font.Size = 12
    .Font.Bold = False
    .ParagraphFormat.Alignment = msoAlignLeft
    'not sure why you are adding white bullets but these lines are probably not needed
    '.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
    x = x + .Height
    End With
    Next L
    End With
    End If
    End If
    oshp.Delete
    Exit Sub
    err:
    MsgBox "Please select a text box"
    End Sub
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Contributor
    Joined
    Dec 2018
    Location
    South London
    Posts
    115
    Location
    Thank you John. I just added:

    .TextFrame2.MarginLeft = 0
    .TextFrame2.MarginRight = 0

    Brilliant. When I first volunteered to improve an old ribbon, it had only 5 tools, now it looks much better, thank you. I'm learning a lot, you've been wonderful. I'm really grateful for your help. Of course, work takes priority and thank you!! Have a great day!

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •