Macro - randomly changing the order of selected objects

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

Sub arrange_left_to_right_random()

Dim srOrig As ShapeRange
Dim srNew As New ShapeRange
Dim lngIndexOrig As Long
Dim lngIndexNew As Long

    ActiveDocument.BeginCommandGroup "position_L_to_R_random"
    
    Set srOrig = ActiveSelectionRange
    
    While srOrig.Count > 0
        lngIndexOrig = Int(Rnd() * (srOrig.Count) + 1)
        srNew.Add srOrig(lngIndexOrig)
        srOrig.Remove lngIndexOrig
    Wend
    
    srNew(1).PositionX = srNew.PositionX
    For lngIndexNew = 2 To srNew.Count
        srNew(lngIndexNew).PositionX = srNew(lngIndexNew - 1).PositionX + srNew(lngIndexNew - 1).SizeWidth
    Next lngIndexNew

    ActiveDocument.EndCommandGroup
End Sub