Sub SaveSelection() Dim s As Shape, n As Long ActivePage.Properties("StoredSelection", 0) = ActiveSelection.Shapes.Count n = 1 For Each s In ActiveSelection.Shapes ActivePage.Properties("StoredSelection", n) = s.StaticID ' Store the current shape's ID number n = n + 1 Next sEnd Sub
Sub RestoreSelection() Dim s As Shape, sr As New ShapeRange Dim v As Variant Dim Num As Long, i As Long, id As Long v = ActivePage.Properties("StoredSelection", 0) ' Retrieving the total number of shape references stored If Not IsNull(v) Then ActivePage.Properties.Delete "StoredSelection", 0 ' Delete the property Num = v For i = 1 To Num id = ActivePage.Properties("StoredSelection", i) ' Getting the current shape's ID to find Set s = ActivePage.FindShape(StaticID:=id) If Not s Is Nothing Then sr.Add s ' Add the shape to the shape range if it still exists in document ActivePage.Properties.Delete "StoredSelection", i ' Delete the property Next i sr.CreateSelection ' Selects all shapes found Else MsgBox "No selection stored in the active page" End If End Sub