Changing Text in grouped shapes

[sebastienm]

Hi,
I have a problem modifying the text in some shapes that are grouped. I encounter no difficulty doing that on non-grouped shapes.
Run the code bellow in a new sheet:
-Sub Add2Rectangles: creates 2 rectangle shapes and set the text for the second one.
-Sub GroupThem: group the two shapes into one group
-Sub ChangeRect2():
- set the font for the 2nd box to strikethrough <-- works
- delete some of the characters of 2nd shape <-- works
- then it try to modify the text of 2nd shape using several methods <-- all FAILS

Now, delete the shapes on the sheet and create a single shape in which you add some text. In ChangeRect2, replace the line:
Set s = ActiveSheet.Shapes(1).GroupItems(2)
by
Set s = ActiveSheet.Shapes(1)
Finally run just ChangeRect2, the code runs perfectly well.

Anybody has an idea?
Thanks
Sebastien

'-------------------------------------------------------
Sub Add2Rectangles()
With ActiveSheet
.Shapes.AddShape msoShapeRectangle, 97.5, 75.75, 76.5, 49.5
.Shapes.AddShape msoShapeRectangle, 119.25, 88.5, 32.25, 14.25
.Shapes(2).TextFrame.Characters.Text = "Ungroup"
End With
End Sub

Sub GroupThem()
Dim sr As ShapeRange
With ActiveSheet
.Shapes.Range(Array(.Shapes(1).Name, .Shapes(2).Name)).Group
End With
End Sub

Sub ChangeRect2()
Dim s As Shape
Dim tf As TextFrame
Dim str As String

Set s = ActiveSheet.Shapes(1).GroupItems(2) 'ActiveSheet.Shapes(1)
Set tf = s.TextFrame

With tf
str = .Characters().Text

'-------WORKS FINE------------------
'Set strikethrough
.Characters().Font.Strikethrough = True
'Delete portion of the text
.Characters(1, 2).Delete

'------- FAILS -----------------
'Inserting characters
.Characters(1).Insert "hihihi"
.Characters(1, 2).Insert "hi"
'Changing the text directly
.Characters.Text = "HHHH"
.Characters(1, 2).Text = "HH"
'Chanhing the text through the OLEObject
s.OLEFormat.Object.Text = "aaa"
s.OLEFormat.Object.Caption = "aaa"

MsgBox s.Name & " = " & TypeName(s.OLEFormat.Object)
End With
End Sub
'--------------------------------------------------

 

[Peter T]

Hi Sebastien,

This has bitten me. Haven't looked recently but searching
a while back suggested the only way to change text (ie
characters, not format) in individual Groupitems is to
ungroup and regroup. I found this hard to accept, went
round in circles before conceding defeat.

One point to bear in mind, if you have a treelike
structure of sub-groups you may need a recursive routine
to ungroup until you find your object. Then similar in
reverse if necessary.

If you find a solution avoiding ungroup / regroup pls post
back.

Regards,
Peter

-----Original Message-----
Hi,
I have a problem modifying the text in some shapes that

are grouped. I encounter no difficulty doing that on non-
grouped shapes.

Run the code bellow in a new sheet:
-Sub Add2Rectangles: creates 2 rectangle shapes and set the text for the second one.
-Sub GroupThem: group the two shapes into one group
-Sub ChangeRect2():
- set the font for the 2nd box to strikethrough <-- works
- delete some of the characters of 2nd shape <-- works
- then it try to modify the text of 2nd shape using several methods <-- all FAILS

Now, delete the shapes on the sheet and create a single

shape in which you add some text. In ChangeRect2, replace
the line: