Handle multiple text boxes together

Question

I have a sub which creates a number (n) of textboxes in a worksheet.

Sub CreateShapes()
Dim sOrd As String
Dim n As Integer
Const iBr = 67

  sOrd = Selection.Text
  
  For n = 1 To Len(sOrd)
  
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 50 + iBr * n, 150 _
        , 200, 70).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Mid(sOrd, n, 1)
  Next n

End Sub

When the sub is finished, the last textbox is selected. How can I select all the n textboxes to group them?

I have tried to find out how to use ShapeRange, but haven't managed.

Answer 1

If there are only the created shapes on the sheet:

Sub CreateShapes()
Dim sOrd As String
Dim n As Integer
Dim selected_shapes As ShapeRange
Const iBr = 67

  sOrd = Selection.Text
  
  For n = 1 To Len(sOrd)
  
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 50 + iBr * n, 150 _
        , 200, 70).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Mid(sOrd, n, 1)
  Next n
  
  
  ActiveSheet.Shapes.SelectAll
  Set selected_shapes = Selection.ShapeRange

End Sub

If there are previously created shapes on the sheet then:

Sub CreateShapes()
Dim sOrd As String
Dim n As Integer
Const iBr = 67
Dim selected_shapes As ShapeRange
  sOrd = Selection.Text
ReDim shape_index(1 To Len(sOrd)) As Long
  
  For n = 1 To Len(sOrd)
  
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 50 + iBr * n, 150 _
        , 200, 70).Select
    shape_index(n) = ActiveSheet.Shapes.Count
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Mid(sOrd, n, 1)
  Next n
  
  
  
  Set selected_shapes = ActiveSheet.Shapes.Range(shape_index)

End Sub