Align flush right

[juanbolas]

With John Wilson's invaluable help, my align left flush left worked great. I got the align to top to work with only minor bumps.

Now I was trying to get it to align right but the shapes end up all over the place. The idea is to then adapt the code to do a flush to bottom.

I think I'm not taking something into account in the "posnext = ". Possibly the width of the next shape.

Thanks in advance





Global Const txDrawAreaLeft As Integer = 60
Global Const txDrawAreaWidth As Integer = 840


Sub AlignRight()
Dim oshpR As ShapeRange
Dim oshp As Shape
Dim L As Long
Dim rayPOS() As Shape
Dim PosTop As Long
Dim PosNext As Long
Set oshpR = ActiveWindow.Selection.ShapeRange
ReDim rayPOS(1 To oshpR.Count)
'add to array
For L = 1 To oshpR.Count
Set rayPOS(L) = oshpR(L)
Next L
'sort
Call sortray(rayPOS)
'apply
For L = 1 To UBound(rayPOS)
If L = 1 Then
Set oshp = rayPOS(L)
PosTop = oshp.Top
PosNext = (txDrawAreaLeft + txDrawAreaWidth) - oshp.Width
Else
Set oshp = rayPOS(L)
oshp.Top = PosTop
oshp.Left = PosNext
PosNext = (txDrawAreaLeft + txDrawAreaWidth) - 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

[juanbolas]

Hello. I solved how to do the align right (the code is bellow).

Now I can't figure out how to align the shapes to the bottom after they're stacked.

Any help is appreciated. Thanks.


Sub StackRight()
Dim oshpR As ShapeRange
Dim oshp As Shape
Dim L As Long
Dim rayPOS() As Shape
Dim PosTop As Long
Dim PosNext As Long
Dim PosRight As Single
Set oshpR = ActiveWindow.Selection.ShapeRange
ReDim rayPOS(1 To oshpR.Count)
'add to array
For L = 1 To oshpR.Count
Set rayPOS(L) = oshpR(L)
PosRight = PosRight + oshpR(L).Width
Next L
MsgBox PosRight
'sort
Call sortray(rayPOS)
'apply
For L = 1 To UBound(rayPOS)
If L = 1 Then
Set oshp = rayPOS(L)
PosTop = oshp.Top
PosNext = oshp.Left + oshp.Width
Else
Set oshp = rayPOS(L)
oshp.Top = PosTop
oshp.Left = PosNext
PosNext = oshp.Left + oshp.Width
End If
Next L
For L = 1 To UBound(rayPOS)
Set oshp = rayPOS(L)
oshp.Left = txDrawAreaWidth - PosRight + oshp.Left
Next L
End Sub

[juanbolas]

Hello. I solved how to do the align right (the code is bellow).

Now I can't figure out how to align the shapes to the bottom after they're stacked.

Any help is appreciated. Thanks.


Sub StackRight()
Dim oshpR As ShapeRange
Dim oshp As Shape
Dim L As Long
Dim rayPOS() As Shape
Dim PosTop As Long
Dim PosNext As Long
Dim PosRight As Single
Set oshpR = ActiveWindow.Selection.ShapeRange
ReDim rayPOS(1 To oshpR.Count)
'add to array
For L = 1 To oshpR.Count
Set rayPOS(L) = oshpR(L)
PosRight = PosRight + oshpR(L).Width
Next L
MsgBox PosRight
'sort
Call sortray(rayPOS)
'apply
For L = 1 To UBound(rayPOS)
If L = 1 Then
Set oshp = rayPOS(L)
PosTop = oshp.Top
PosNext = oshp.Left + oshp.Width
Else
Set oshp = rayPOS(L)
oshp.Top = PosTop
oshp.Left = PosNext
PosNext = oshp.Left + oshp.Width
End If
Next L
For L = 1 To UBound(rayPOS)
Set oshp = rayPOS(L)
oshp.Left = txDrawAreaWidth - PosRight + oshp.Left
Next L
End Sub

[Willy23]

I also had some problems with these retro bowl (https://retrobowlgo.com/) alignments, did you find a solution?