View Single Post
  #6  
Old 27-01-2009, 02:59
SanchoFilin's Avatar
SanchoFilin SanchoFilin is offline
Junior Member
 
Join Date: Jan 2009
Posts: 5
Default

Code:
Sub Test()
    Dim s As Shape, g As Shape, s2 As Shape, sr As New ShapeRange
    Set s = ActiveShape
    If s Is Nothing Then MsgBox "Please select an object", vbCritical: Exit Sub
    Set g = s.ParentGroup
    If g Is Nothing Then MsgBox "Please select an object within a group", vbCritical: Exit Sub
    s.name = "myShape"
    g.Duplicate 0, 0
    Set sr = g.UngroupEx
    s.name = ""
    sr.CreateSelection
    s.Selected = False
    ActiveSelection.Delete
    Set s2 = ActiveLayer.FindShape("myShape")
    s2.Delete
    's.OrderForwardOne
    s.CreateSelection
End Sub

Last edited by SanchoFilin; 27-01-2009 at 03:01.
Reply With Quote