PowerPoint VBA z-order based on shape position on slide

257 Views Asked by At

I would like to reorder (z-order) my 'lassoed' selection of shapes based on their position. My current macro ignores their position and the loop loops through the shapes based on their existing z-order which defeats the purpose of the loop!

For example I have 3 shapes in a grid with '1 row' and '3 columns'. When I lasso select the shapes with my mouse and run this macro, I want the left most shape to the in the front, the next shape (middle shape) to be one z-order behind, and the right most shape to then be one z-order behind of the middle shape.

Current code below:

Dim shp As Shape

For each shp in Activewindow.Selection.ShapeRange
shp.zorder msoBringToFront
Next
2

There are 2 best solutions below

5
FunThomas On

As far as I understand, the main task is to sort a list of shapes by position.

The following function will sort a list of shapes and return an array of shapes in the correct order. You can call it either with a ShapeRange or with Shapes as argument: Use ShapeRange for selection or use slide.Shapes to deal with all shapes of a slide.

The function uses a simple Quicksort to sort by the position of the shapes. I use the round-function because the position of the shapes might be slightly different, even if you align them.

Function orderShapes(shapeRange) As shape()
    ' shapeRange can be either of type ShapeRange or of type Shapes
  
    If shapeRange.Count = 0 Then Exit Function
  
    ' Fill an array with all shapes.
    ReDim shapeArray(1 To shapeRange.Count) As shape
    Dim i As Long, j As Long
    For i = 1 To shapeRange.Count
        Set shapeArray(i) = shapeRange(i)
    Next
    
    ' Sort by position (left/top). 
    For i = 1 To UBound(shapeArray) - 1
        For j = i To UBound(shapeArray)
            Dim left1 As Double, left2 As Double, top1 As Double, top2 As Double
            left1 = Round(shapeArray(i).Left, 1)
            top1 = Round(shapeArray(i).Top, 1)
            left2 = Round(shapeArray(j).Left, 1)
            top2 = Round(shapeArray(j).Top, 1)
            If left1 > left2 Or (left1 = left2 And top1 > top2) Then
                ' Use this to sort from top to bottom:
                ' If top1 > top2 Or (top1 =  top2 And left1 > left2) Then
                Dim tmpShape As shape
                Set tmpShape = shapeArray(i)
                Set shapeArray(i) = shapeArray(j)
                Set shapeArray(j) = tmpShape
            End If
        Next
    Next
    
    orderShapes = shapeArray
End Function

Now with the resulting array you can do whatever you want. The following routine will sort the shapes of a slide and write the index as text:

Sub slTest()
    Dim sl As Slide
    Set sl = ActivePresentation.Slides(1)
    Dim a() As shape
    a = orderShapes(sl.Shapes)
    ' Use this to sort only the selected shapes: 
    ' a = orderShapes(ActiveWindow.Selection.shapeRange)

    Dim i As Long
    For i = 1 To UBound(a)
        a(i).TextFrame.TextRange.Text = "  I am shape " & i
    Next
End Sub

Of course, you can use it also to set the zOrder:

Sub setZOrderOfShapes(shapeRange)
    Dim a() As shape, i As Long
    a = orderShapes(shapeRange)
    
    For i = 1 To UBound(a)
        a(i).ZOrder msoBringToFront
    Next
End Sub
1
Jingle123 On

Thomas, in the following example. I have 6 shapes in a grid of 3x2. With their 'shape number' in the textbox as their respective z-order:

Starting shape grid with z-order

If i run the code as it is now (I've changed the sort logic to have top1>top2 condition first), it will sort the shapes from top to bottom such that the z-order is which isn't what I want:

Z-order after running code

Is there a way code the macro in a way that will algin the first row's shapes to top, and then second row of shapes to align top such that they look like:

Shapes aligned top per row

The code provided works as intended in only two scenarios; shapes are already aligned top for each row (the 'top1 = top2 And left1 > left2' condition will determine the order) or if each shape in each row has a higher x position to the shape to the right, like:

Example working arrangement

The code you provided is intended to be used for a separate macro which aligns the selected shapes into a grid with specified number columns and spacing between each shape by the user through a userform with input boxes.

The logic I'm envisioning will be something like:

  • user select shapes and runs macro
  • show userform (done)
  • user enters number of columns and shape spacing (done)
  • z-order sorting macro which knows how many shapes are in each row from the user form and then align top for shapes for each row respectively, then sort from top to bottom from left to right
  • run the macro which aligns the shapes into a grid with user define parameters in the user form (done)