Breaking text apart

with text selected

sr.Duplicate.CreateSelection
set sr = ActiveShapeRange
sr.BreakApart

now only one character is selected

how to add the other characters back to the ShapeRange.

  • set sr = sr.BreakApartEx

    • Same result

      • Function BreakText(TextShape As Shape) As ShapeRange
        Dim sr As ShapeRange, n As TreeNode, LastShape As Shape
            Set n = TextShape.TreeNode.Previous
            Set sr = TextShape.BreakApartEx
            If n Is Nothing Then
                Set LastShape = sr(1).Layer.Shapes.First
            Else
                Set LastShape = n.Shape.Next
            End If
            While sr.LastShape.StaticID <> LastShape.StaticID
                sr.Add sr.LastShape.Previous
            Wend
            Set BreakText = sr
        End Function
        
        Private Sub TestBreakText()
        Dim s As Shape, sr As ShapeRange
            Set s = ActiveShape
            Set sr = BreakText(s)
            For Each s In sr
                Debug.Print s.Text.Story.Text
            Next
        End Sub
        
        • hmmm, missing something. 

          I actually messed around and came up with a solution.
          name the shape first then query for the named shapes after breaking apart.

      • Hello Myron.
        I didn't understand exactly what you wanted to do.
        Break the text into parts, for what? To add other characters to the text? Or you need just to add characters to the text?

        Taras

        • I have what what I was ultimately after.

          What I was wanting to do, to start, was to break apart text but still have each character selected. 
          Running your code above beginning with "PrivateSub"...
          I'm probably not using it correctly though?
          Breaks the text apart but still leaves only 1 character selected.

          •     Set s = ActiveShape
                Set sr = BreakText(s)
            sr.CreateSelection
            • Are you actually testing these? Still doesn't work.

              • Hi, Myron

                Change my code to:

                Function BreakText(TextShape As Shape) As ShapeRange
                Dim sr As ShapeRange, n As TreeNode, LastShape As Shape
                    Set n = TextShape.TreeNode.Previous
                    Set sr = TextShape.BreakApartEx
                    If n Is Nothing Then
                        Set LastShape = sr(1).Layer.Shapes.First
                    Else
                        Set LastShape = n.Shape.Next
                    End If
                    While sr.LastShape.StaticID <> LastShape.StaticID
                        sr.Add sr.LastShape.Previous
                    Wend
                    Set BreakText = sr
                End Function
                
                Sub TestBreakText()
                Dim s As Shape, sr As ShapeRange
                    Set s = ActiveShape
                    Set sr = BreakText(s)
                    sr.AddToSelection
                End Sub
                
                • Yes, that does it.