As it is, if you group several objects together, they all move to the "active layer." for example if I have several objects that are on multiple layers that I need to group for alignment, etc... and I want them to all stay on the layers they are set to.... they will all move to the "active layer" when they are grouped. Then I have to go back afterward and individually select them all and move them back to the layers they belong on....
Sub GroupShapeRange() 'group shapes from many layers align then ungroup back to respective layers
Dim sr As ShapeRange, s As Shape
Set sr = ActiveSelectionRange
For Each s In sr
s.Name = (s.Layer.Name)
Next s
ActiveSelection.Group
End Sub
----------------------------------------------------------------------
Sub UngroupMoveToRespectiveLayers()
sr.Ungroup
s.Layer = ActivePage.Layers(s.Name)
I like your idea here, Myron.
If you wanted to preserve the Name of each shape, you could store the "layer it came from" information as custom data associated with the shape.
Sub GroupShapeRange() 'group shapes from many layers align then ungroup back to respective layersDim sr As ShapeRange, s As Shape Set sr = ActiveSelectionRange If ActiveDocument.DataFields.IsPresent("Original_Layer") = False Then ActiveDocument.DataFields.Add "Original_Layer", "General" End If For Each s In sr s.ObjectData("Original_Layer") = s.Layer.Name Next s ActiveSelection.GroupEnd Sub
Sub UngroupMoveToRespectiveLayers()Dim sr As ShapeRange, s As Shape If ActiveDocument.DataFields.IsPresent("Original_Layer") = False Then MsgBox "No custom data field is present for recording original layer information, so this macro is not applicable." Exit Sub End If Set sr = ActiveSelectionRange sr.Ungroup For Each s In sr If s.ObjectData("Original_layer") = "" Then MsgBox "No original layer was recorded for this shape." Else s.MoveToLayer ActivePage.Layers((s.ObjectData("Original_Layer"))) s.ObjectData("Original_layer") = "" End If Next sEnd Sub