GroupItems - different results starting with 2002(XP)

P

pH7

The following code example works as I expect in XL1997 and XL2000 but i
XL2002 and XL2003 GroupItems seems to flatten the result by traversin
the hierarchy of groups itself and only returning all objects in th
hierarchy and no sub-groups.

Is there any way to make it work the same in XL2002 and beyond? (
would prefer to not do ungroup and regroup, since the objects are on
protected sheet.)

My results in the older versions look like:

Code
-------------------
Group 52
Group 48
Oval 45
Line 46
Line 47
Group 51
Oval 49
Line 50

-------------------

And my results in the newer versions look like:

Code
-------------------
Group 52
Oval 45
Line 46
Line 47
Oval 49
Line 50

-------------------

Here is the code:

Code
-------------------

Sub main()
Dim dump_row As Integer
Dim dump_col As Integer
Dim shp As Shape

Call setup_example

dump_row = 1
dump_col = 1
For Each shp In ActiveSheet.Shapes
Call dump(shp, dump_row, dump_col)
Next
End Sub
Sub dump(shape_to_dump As Shape, dump_row As Integer, dump_col As Integer)
Dim shp As Shape

ActiveSheet.Cells(dump_row, dump_col).Value = shape_to_dump.Name
dump_row = dump_row + 1
If shape_to_dump.Type = msoGroup Then
dump_col = dump_col + 1
For Each shp In shape_to_dump.GroupItems
Call dump(shp, dump_row, dump_col)
Next
dump_col = dump_col - 1
End If
End Sub
Sub setup_example()
' Create the objects and hierarchy of groups

ActiveSheet.Shapes.AddShape(msoShapeOval, 191.25, 102#, 24#, 24#).Select
oval1 = Selection.Name
Selection.Characters.Text = "A"
ActiveSheet.Shapes.AddLine(144.75, 114#, 181.5, 114#).Select
line1 = Selection.Name
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
ActiveSheet.Shapes.AddLine(221.25, 114.75, 256.5, 114.75).Select
line2 = Selection.Name
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
Selection.ShapeRange.Flip msoFlipHorizontal
ActiveSheet.Shapes.Range(Array(oval1, line1, line2)).Group.Select
group1a = Selection.Name

ActiveSheet.Shapes.AddShape(msoShapeOval, 191.25, 153.75, 24.75, 24.75).Select
oval2 = Selection.Name
Selection.Characters.Text = "B"
ActiveSheet.Shapes.AddLine(228#, 166.5, 276#, 166.5).Select
line3 = Selection.Name
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
ActiveSheet.Shapes.Range(Array(oval2, line3)).Group.Select
group1b = Selection.Name

ActiveSheet.Shapes.Range(Array(group1a, group1b)).Group
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top