Consulting

Results 1 to 4 of 4

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

  1. #1
    VBAX Newbie
    Joined
    Oct 2022
    Posts
    2
    Location

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

    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!

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,064
    Location
    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.
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Newbie
    Joined
    Oct 2022
    Posts
    2
    Location

    Hey John! Thanks for your comment!

    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

    Quote Originally Posted by John Wilson View Post
    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.

  4. #4
    VBAX Regular
    Joined
    Dec 2018
    Posts
    19
    Location
    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

Posting Permissions

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