'Align shapes flush/stacked/touching
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.
Sub AlignFlush()
Dim oshpR As ShapeRange
Dim oshp As Shape
Dim L As Long
Dim rayPOS() As Single
Set oshpR = ActiveWindow.Selection.ShapeRange
ReDim rayPOS(1 To oshpR.Count)
'add to array
For L = 1 To oshpR.Count
rayPOS(L) = oshpR(L).Left
Next L
'sort
Call sortray(rayPOS)
'apply
For L = 1 To oshpR.Count
If L = 1 Then
Set oshp = Windows(1).Selection.ShapeRange(1)
PosTop = oshp.Top
PosNext = oshp.Left + oshp.Width
Else
Set oshp = Windows(1).Selection.ShapeRange(L)
oshp.Top = PosTop
oshp.Left = PosNext
PosNext = oshp.Left + oshp.Width
End If
Next L
End Sub
Sub sortray(ArrayIn As Variant)
Dim b_Cont As Boolean
Dim lngCount As Long
Dim vSwap As Long
Do
b_Cont = False
For lngCount = LBound(ArrayIn) To UBound(ArrayIn) - 1
If ArrayIn(lngCount) > ArrayIn(lngCount + 1) Then
vSwap = ArrayIn(lngCount)
ArrayIn(lngCount) = ArrayIn(lngCount + 1)
ArrayIn(lngCount + 1) = vSwap
b_Cont = True
End If
Next lngCount
Loop Until Not b_Cont
End Sub
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|
