Consulting

Results 1 to 3 of 3

Thread: sort shapes left to right in order of their selection

  1. #1
    VBAX Contributor
    Joined
    Apr 2015
    Location
    Germany
    Posts
    167
    Location

    sort shapes left to right in order of their selection

    Hi all,

    sorting (and using arrays in general) is still some floors above my coding level, so this time I'm afraid, I need more than only a little hint or a sharp eye to make my idea work. Thanks in advance!


    My idea is to sort shapes left to right in order of their selection by keeping the positions used for the shapes before sorting them. I was able to modify a piece of code I found here in the forum to make the left-to-right-order of some selected shapes dependent on the selection order. (See below) But that was only a part of what I would like to get. What I'm not able to do is: Bring the first selected shape exactly to the left position of the shape that was the far left before. And the one selected second to the left position of the shape that was second from left before. And so on.

    To make an example:
    Shape A ist positioned at 100, Shape B at 220, Shape C at 400 and Shape D at 480 from left slide border.
    I click Shape D first, then C, then B, then A.
    Afte using the macro, Shape D is positioned at 100, Shape C at 220, Shape B at 400 and Shape A at 480.
    And of course, the macro has to be flexible in number of shapes and positions, it has to work with variables.

    So my problems are to make the macro remember the position of the shapes before sorting and to give the correct (old) postions to the moved shapes. Hope, it is clear, what I would like to achieve.

    This is the part I have:

    Sub SortByOrderOfSelection()
        Dim myArray() As Shape
        Dim L As Long
        
        On Error Resume Next
        If ActiveWindow.Selection.ShapeRange.Count < 2 Then
            MsgBox "Please select at least two shapes"
            Exit Sub
        End If
    
    'Here the part of the code to let the macro now the old positions is missing
    
    
        On Error GoTo 0
    'The following part is sorting by order of selection.
    'It works, but the commented line close to the end has to be modified,
    'as the goal is to use the old postion of all shapes,
    'not only the first selected,
    'and not to stack all of them together as it is at the moment
        ReDim myArray(1 To ActiveWindow.Selection.ShapeRange.Count)
        For L = 1 To ActiveWindow.Selection.ShapeRange.Count
            Set myArray(L) = ActiveWindow.Selection.ShapeRange(L)
        Next L
        For L = 2 To UBound(myArray)
            Debug.Print myArray(L).Name
    'The following line of code, stacking all shapes together, has to be replaced by a way to set the sorted shapes on the positions of the old arrangement
    'I just used it to let something happen at all ;-)
            myArray(L).Left = myArray(L - 1).Left + myArray(L - 1).Width 
        Next L
    End Sub
    I know, it is not much, what I have here, but after spending a lot of time googling and trying by myself, I have to accept I'm not able to do it by myself at this stage. Hope to learn more about using arrays from this example.

    Thank you,
    RG

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    I would try starting with the left values in an array, sort the array and then apply to the selected shapes in order.

    The code will need work but I know you can do that.

    Sub swapper()  
     Dim oshpR As ShapeRange
       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
          oshpR(L).Left = rayPOS(L)
       Next
    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Contributor
    Joined
    Apr 2015
    Location
    Germany
    Posts
    167
    Location
    Amazing!

    In one of my tries that failed I was quite close to the part you called "swapper" and now I see, what I've done wrong with it. But I don't think I would have been able to solve the "sortray" problem. I have to find out more about the boolean and the way you used it here.

    Thank you, John, you're help is priceless!

Posting Permissions

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