オートシェイプとオートシェイプの間の隙間を消す ref: http://qiita.com/shibainurou/items/19ccc1ebf99b70de0e19

file0.txt

'選択されているオートシェイプをくっつける(横)
Sub SelectionShapesMagnetHorizon()

    Dim ShapesInfo() As StShapesInfoH
    ReDim ShapesInfo(Selection.ShapeRange.count - 1)

    Dim t As Integer
    Dim i As Integer
    For i = 0 To Selection.ShapeRange.count - 1
        ShapesInfo(i).index = i + 1  ' 一意になるデータが無いのでindexを使う
        ShapesInfo(i).left = Selection.ShapeRange(i + 1).left
        ShapesInfo(i).width = Selection.ShapeRange(i + 1).width
    Next


    '最大取得
    Dim work As StShapesInfoH
    Dim max As StShapesInfoH
    Dim index As Integer

    For i = 0 To Selection.ShapeRange.count - 1
        max.index = -1
        max.left = 0
        max.width = 0
        index = 0

        For t = i To Selection.ShapeRange.count - 1
            ' 同じ位置にあるシェイプのindexが-1になっちゃうので同じだったら、後ろのほうが大きい
            If max.left <= ShapesInfo(t).left Then
                max = ShapesInfo(t)
                index = t
            End If
        Next
        work = ShapesInfo(i)
        ShapesInfo(i) = max
        ShapesInfo(index) = work
    Next

    Dim j As Integer
    For i = Selection.ShapeRange.count - 1 To 1 Step -1
        ShapesInfo(i - 1).left = ShapesInfo(i).left + ShapesInfo(i).width
    Next

    For i = 0 To Selection.ShapeRange.count - 1
        Selection.ShapeRange(ShapesInfo(i).index).left = ShapesInfo(i).left
    Next

End Sub


'選択されているオートシェイプをくっつける(縦)
Sub SelectionShapesMagnetVertical()

    Dim ShapesInfo() As StShapesInfoV
    ReDim ShapesInfo(Selection.ShapeRange.count - 1)

    Dim t As Integer
    Dim i As Integer
    For i = 0 To Selection.ShapeRange.count - 1
        ShapesInfo(i).index = i + 1 ' 一意になるデータが無いのでindexを使う
        ShapesInfo(i).top = Selection.ShapeRange(i + 1).top
        ShapesInfo(i).height = Selection.ShapeRange(i + 1).height
    Next


    '最大取得
    Dim work As StShapesInfoV
    Dim max As StShapesInfoV
    Dim index As Integer

    For i = 0 To Selection.ShapeRange.count - 1
        max.index = -1
        max.top = 0
        max.height = 0
        index = 0

        For t = i To Selection.ShapeRange.count - 1
            ' 同じ位置にあるシェイプのindexが-1になっちゃうので同じだったら、後ろのほうが大きい
            If max.top <= ShapesInfo(t).top Then
                max = ShapesInfo(t)
                index = t
            End If
        Next
        work = ShapesInfo(i)
        ShapesInfo(i) = max
        ShapesInfo(index) = work
    Next

    Dim j As Integer
    For i = Selection.ShapeRange.count - 1 To 1 Step -1
        ShapesInfo(i - 1).top = ShapesInfo(i).top + ShapesInfo(i).height
    Next

    For i = 0 To Selection.ShapeRange.count - 1
        Selection.ShapeRange(ShapesInfo(i).index).top = ShapesInfo(i).top
    Next
End Sub