Consulting

Results 1 to 4 of 4

Thread: Align flush right

  1. #1

    Align flush right

    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

  2. #2
    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

  3. #3
    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

  4. #4
    Banned VBAX Newbie
    Joined
    Jun 2023
    Posts
    2
    Location
    I also had some problems with these retro bowl alignments, did you find a solution?

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •