HasTextFrame in msoGroup

[RandomGerman]

Hi there,

I created a piece of code to scale objects within groups. Without ungrouping, because I want to keep the proportion of the group. (In the code the 50% is just an example, in fact, I work with an Input box, which is fine)

Now the problem is about the font size. When there is only one shape with text part of the group, everything works fine. But as soon as I have two or more shapes with text, the code seems to run two or three times - always as often as the number of shapes with text. So it probably has something to do with the counting, but as I want to scale text in all objects, how can I avoid it?

Thank you for your ideas.


Sub ScaleGroup()
Dim x As Long
Dim shp As Shape

For Each shp In ActiveWindow.Selection.ShapeRange
If shp.Type = msoGroup Then
shp.Width = shp.Width / 100 * 50
shp.Height = shp.Height / 100 * 50
For x = 1 To shp.GroupItems.Count
If shp.GroupItems(x).HasTextFrame Then
shp.TextFrame2.TextRange.Font.Size = shp.TextFrame2.TextRange.Font.Size / 100 * 50
End If
Next x
End If
Next
Exit Sub
End Sub

[John Wilson]

There's a typo in your code

If shp.GroupItems(x).HasTextFrame Then
shp.GroupItems(x).TextFrame2.TextRange.Font.Size = shp.GroupItems(x).TextFrame2.TextRange.Font.Size / 100 * 50
End If

[RandomGerman]

Sometimes it is simpler than expected. Thank you for your sharp eye, John.