Align shapes flush/stacked/touching

[michaelhaag]

Hello,
I'm trying to get a selection of shapes in order from right to left. I found a routine by John Wilson on vbaexpress on which I based my code.


The sorting works perfectly when I select item by item by clicking on the shapes but it doesn't respect the "visible order" of shapes if I select them by "lassoing" with my mouse.


In case of dragging my mouse over the shapes to select them, the routine should respect the visible order of shapes.


Thanks in advance.

[Aussiebear]

A quick search on Google suggests that you might be able to do the following

1. Grouping:


Simple and Effective:

After lassoing your shapes, immediately press Ctrl+G (or right-click and select "Group"). This turns your selected shapes into a single object.




Now, you can move, resize, and rotate the entire group while preserving the relative positions of the individual shapes within it.




To edit individual shapes later, right-click the group and select "Ungroup."

[medarda]

To align PowerPoint shapes flush and in the correct visible order when selecting with a lasso, you'll need to sort the shapes based on their positions rather than relying on the selection order.

Sub AlignShapesFlush()
Dim shp As Shape
Dim shpArray As Object
Dim i As Integer, j As Integer
Dim temp As Shape
Dim slide As slide
Set slide = ActiveWindow.View.Slide
' Store selected shapes in an array
Set shpArray = CreateObject("Scripting.Dictionary")
For Each shp In ActiveWindow.Selection.ShapeRange
shpArray.Add shpArray.Count, shp
Next shp
' Sort shapes from right to left (by .Left position descending)
For i = 0 To shpArray.Count - 2
For j = i + 1 To shpArray.Count - 1
If shpArray(i).Left < shpArray(j).Left Then
Set temp = shpArray(i)
Set shpArray(i) = shpArray(j)
Set shpArray(j) = temp
End If
Next j
Next i
' Align shapes touching each other (flush)
Dim currentLeft As Single
currentLeft = shpArray(0).Left + shpArray(0).Width ' Start at the rightmost shape
For i = 1 To shpArray.Count - 1
shpArray(i).Left = currentLeft
currentLeft = shpArray(i).Left + shpArray(i).Width
Next i
' Cleanup
Set shpArray = Nothing
Set slide = Nothing
End Sub