Configure z-order position of shape

[Jhon90]

Sir need some help.


I want to replace rectangle shape to my freeform shape within a group(group has four shapes & animation also).
But not configure the z-order position of new freeform shape(will be same z-order position of rectangle shape)

So what I have done:
1.pickup animation of group
2.Calculated z-order position of rectangle & its 1
3.Ungroup
4.paste freeform shape
5.Capture properties of rectangle such as location and size
6.apply properties to freeform shape
7.delete rectangle shape
8.group all(four shape which include freeform shape also)
9.apply animation to group
10.Calculated z-order position of freeform shape & its 4(within group)
11.WANT TO GIVE SAME Z-ORDER POSITION(ie 1) TO FREEFORM SHAPE AS RECTANGLE SHAPE(I DELETED)


I try below code but not working. Please help



Sub reposition()
Dim osld As Slide
Dim TZ As Long
Dim ZO As Long
Set osld = ActivePresentation.Slides(1)
'ZO is z-order position of freeform shape & its 4
'TZ is z-order position of rectangle shape & its 1
With osld.Shapes("Group1").GroupItems(ZO)
While .ZOrderPosition > 1
.ZOrder msoSendBackward
Wend
End With

[John Wilson]

As far as I know it is not possible to reorder shapes within a group using vba.

Also a shape inside a group cannot have a z order of 1 - are you sure the GROUP doesn't have a zorder of 1?

If you have a group with two groupitems at the back of a slide the Group Zorder will be 1 and the group items 2 & 3 The group items will never be 1

Try naming the groupitems (so you know which is which)
UNGROUP
get the z order of the shape to be removed
remove it and add the new shape
Move it's zoder to the removed shape order and then regroup

[Jhon90]

Thanks Sir for your reply & suggestion. I tried your suggestion but I am doing wrong somewhere & not getting my result. I added my example file. Please look into where I am doing wrong.

[Jhon90]

Sir I tried below code but not getting result



Sub replace_shape()
Dim osld As Slide
Dim oshp As Shape
Dim gshp As Shape
Dim hshp As Shape
Dim pshp As ShapeRange
Dim j As Long
Dim t As Long
Dim l As Long
Dim h As Long
Dim w As Long
Dim x As Long
Dim s As Long
Dim TopZ As Long
Dim TopGZ As Long
Dim GZ As Long
Dim zposition As Long
Dim finalposition As Long
Dim GIC As Long
Dim GII As Long
Dim GIZ As Long
'On Error Resume Next
Set oshp = ActiveWindow.Selection.ShapeRange(1)
oshp.Copy
If Err Then Exit Sub
Set osld = ActivePresentation.Slides(1)
For j = 1 To 2
' capture group/shape z-order position------------
GIC = osld.Shapes("Group" & j).GroupItems.Count
GZ = osld.Shapes("Group" & j).GroupItems(GIC).ZOrderPosition
'Exit Sub
'--------- end -------------------------------------
Set gshp = osld.Shapes("Group" & j)
gshp.PickupAnimation
If gshp.Type = msoGroup Then
gshp.Ungroup
End If
' capture group items z-order position after ungroup ------------
GIZ = osld.Shapes("Oval" & j).ZOrderPosition
'--------- end -------------------------------------
Set hshp = osld.Shapes("Oval" & j)
Set pshp = osld.Shapes.Paste
With pshp
.Left = hshp.Left
.Top = hshp.Top
.Height = hshp.Height
.Width = hshp.Width
End With
hshp.Delete
With pshp
.Name = "Oval" & j
End With
'-----apply z-order postion back to shape ie in Oval----------
With osld.Shapes.AddShape(msoShapeRectangle, 1, 1, 1, 1)
TopZ = .ZOrderPosition - 1
.Delete
End With
Do
osld.Shapes("Oval" & j).ZOrder (msoBringForward)
' check the last groupitem not the group itself
Loop While osld.Shapes("Oval" & j).ZOrderPosition < GIZ
'--------- end -------------------------------------------------
Set gshp = osld.Shapes.Range(Array("Oval" & j, "TextBoxTop" & j, "TextBoxBottom" & j, "Rectangle" & j)).Group
gshp.ApplyAnimation
gshp.Name = "Group" & j
'-----apply z-order postion back to group ----------
With osld.Shapes.AddShape(msoShapeRectangle, 1, 1, 1, 1)
TopGZ = .ZOrderPosition - 1
.Delete
End With
Do
osld.Shapes("Group" & j).ZOrder (msoBringForward)
Loop While osld.Shapes("Group" & j).GroupItems(GIC).ZOrderPosition < GZ
'--------- end -------------------------------------------------
Next j
MsgBox "Shape replace successfully!"
End Sub

[Jhon90]

Now I configured.