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
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