Consulting

Results 1 to 2 of 2

Thread: Split Text Box by Bullets with no extra return

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

    Split Text Box by Bullets with no extra return

    Hi John

    I used this code you kindly created; I can't find how to remove the extra 'return' it puts in each next bullet's text box?
    I've experimented, but alas, no luck. Thank you and have a super weekend!

    Code:

    Sub SplitTextBoxes()
    Dim oShp As Shape
    Dim osld As Slide
    Dim L As Long
    Dim otr As TextRange2
    Dim X As Integer
    On Error GoTo err
    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
                       .TextFrame2.MarginLeft = 0
                       .TextFrame2.MarginRight = 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(219, 0, 17)
                           .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
    Last edited by Aussiebear; 04-27-2023 at 03:35 PM. Reason: Reduced the whitespace

  2. #2
    Try this:

    Sub Split_Text_Boxes()
    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 = Replace(otr.Text, vbCr, "")
                            .Font.Size = 12
                            .Font.Bold = False
                            .ParagraphFormat.Alignment = msoAlignLeft
                        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
    Last edited by Aussiebear; 04-27-2023 at 03:37 PM. Reason: Indented code

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
  •