'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