Consulting

Results 1 to 5 of 5

Thread: Configure z-order position of shape

  1. #1
    VBAX Regular
    Joined
    Sep 2020
    Posts
    30
    Location

    Configure z-order position of shape

    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


    PHP Code:
    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 

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,057
    Location
    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
    Last edited by John Wilson; 12-08-2021 at 07:37 AM.
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Regular
    Joined
    Sep 2020
    Posts
    30
    Location
    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.
    Attached Files Attached Files

  4. #4
    VBAX Regular
    Joined
    Sep 2020
    Posts
    30
    Location
    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
    Attached Files Attached Files

  5. #5
    VBAX Regular
    Joined
    Sep 2020
    Posts
    30
    Location
    Now I configured.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •