【VBA】パワポの図形を重なっている順に整列させるには【PowerPoint】

Option Explicit

Sub 重ならないように横に並べる()
    
    With ActiveWindow.Selection
        If .Type <> ppSelectionShapes Then Exit Sub '選択されたものがShapesでなければ処理終了
        
        Dim lMax As Long
        lMax = .ShapeRange.Count
                
        'ZOrderPositionに応じて、ShapesのTopとLeftの情報を編集する
        Dim ii As Long
        For ii = 1 To lMax - 1
            Call AlignTwoShapes(.ShapeRange, ii)   '2つのShapesを整列させる処理
        Next ii
        
        'ここまでで整列しているはずだが、念のため上下左右に整列させる
        With .ShapeRange
          .Distribute msoDistributeVertically, msoFalse
          .Distribute msoDistributeHorizontally, msoFalse
        End With
    End With

End Sub

Private Sub AlignTwoShapes(ByRef Poss As Object, ByVal lZorder As Long)
    Dim BaseTop As Long
    Dim BaseLeft As Long
    Dim SecondLeft As Long
    Dim lMax As Long
    Dim ii As Long
    
    lMax = Poss.Count
    'lZorderと同じZOrderShapeの情報を把握する
    For ii = 1 To lMax
        If Poss(ii).ZOrderPosition = lZorder Then
            BaseTop = Poss(ii).Top
            BaseLeft = Poss(ii).Left
            SecondLeft = BaseLeft + Poss(ii).Width
            Exit For
        End If
    Next ii
            
    'lZOrder+1と同じZorderのShapeの情報を編集する
    For ii = 1 To lMax
        If Poss(ii).ZOrderPosition = lZorder + 1 Then
            Poss(ii).Top = BaseTop
            Poss(ii).Left = SecondLeft
            Exit For
        End If
    Next ii
End Sub