Public Sub 選択している画像を縦に連結してグループ化する()

    If VarType(ActiveWindow.Selection) = vbObject Then
        Set tgtShapes = ActiveWindow.Selection.ShapeRange
        If ActiveWindow.Selection.ShapeRange.Count < 2 Then
            MsgBox "画像が2個以上選択されていません。" 
            End
        End If
        ' 左詰めで整列
        Selection.ShapeRange.Align msoAlignLefts, msoFalse
        ' 一番上の画像の位置を取得
        Dim preTop As Long: preTop = tgtShapes(1).Top
        For Each shp In tgtShapes
            If preTop > shp.Top Then
                preTop = shp.Top
            End If
        Next shp
        ' 連結処理
        Dim Count As Integer
        Dim tmpTop As Long: tmpTop = 0
        Count = 0
        For Each shp In tgtShapes
            tmpTop = preTop
            For Each compShp In tgtShapes
                '処理対象より上にある場合
                If shp.Top > compShp.Top Then
                    '上の画像の下に対照画像の高さを足す
                    tmpTop = tmpTop + compShp.Height
                End If
            Next compShp
            '処理対象の位置を更新
            If shp.Top > tmpTop Then
                shp.Top = tmpTop
            End If
        Next shp
        ' グループ化
        tgtShapes.Group
    Else
        MsgBox "画像が選択されていません。", vbCritical
    End If

End Sub

사용 예

실행 전

실행 후