Align shapes flush/stacked/touching

Question

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

Answer 1

Some comments on your existing code:

Array counts always start at 0 unless you use the Option Base statement to set it to a different number.

When you use ReDim, most of the time, you want to use the Preserve keyword, or the ReDim obliterates the existing array contents. But in this case, we know the array size ahead of time, so Preserve is not necessary.

You call sortray, but didn't include it in your listing. I've added a sorting routine.

But then you make no use of the sorted array in the section where you position the shapes.

Working macro (based on your description of what you mean by "visible order" being the left-to-right sequence):

Since you use the left position of the leftmost shape to apply to the others, here's a simpler way to do that:

Sub AlignFlushLeftWithLeftmostShape()
    Dim ShpCount As Long
    Dim oshpR As ShapeRange
    Dim L As Long
    Dim rayPOS() As Single
       
    Set oshpR = ActiveWindow.Selection.ShapeRange
    
    ShpCount = oshpR.Count
    
    ReDim rayPOS(ShpCount - 1)
    
    For L = 0 To ShpCount - 1
       rayPOS(L) = oshpR(L + 1).Left
    Next L

    Call BubbleSort(rayPOS)

    For x = 1 To ShpCount
        oshpR(x).Left = rayPOS(0)
    Next x
End Sub
  
Sub BubbleSort(arr)
    Dim lTemp As Long
    Dim i As Long
    Dim j As Long
    Dim lngMin As Long
    Dim lngMax As Long
    lngMin = LBound(arr)
    lngMax = UBound(arr)
    For i = lngMin To lngMax - 1
        For j = i + 1 To lngMax
            If arr(i) > arr(j) Then
                lTemp = arr(i)
                arr(i) = arr(j)
                arr(j) = lTemp
            End If
        Next j
    Next i
End Sub