VBAで図形をグループ化する方法

2021年3月15日2024年7月17日

VBAの図って、セル（Range）と比べると扱い方が難しいですよね。

そんな扱いづらい図形ですが、操作方法は限られているのでコードを数パターン覚えておけば後は応用が利きます。（基本的にShapesコレクションからShapeオブジェクトを取り出す）

今回は図形をグループ化する方法を紹介します。

シート内の全ての図形をグループ化
【応用】範囲内の図形だけをグループ化

の2つを紹介するのでVBAでグループ化をしたい人は参考にしてみてください。

シート内の全ての図形をグループ化

Sub ShpGroup()
'ActiveSheet上の図形をすべてグループ化
    
    On Error GoTo ErrorTrap '図形が1つだとエラーとなる
    ActiveSheet.Shapes.SelectAll
    Selection.Group
    Exit Sub
    
ErrorTrap:
    MsgBox "グループ化するには2つ以上のシェイプが必要です"
End Sub

ActiveSheet.Shapes.SelectAllでシート上のすべての図形を選択し、
Selection.Groupで選択した図形をグループ化しています。

図形が1つだとグループ化に失敗するため、On Error GoToを入れておくことを推奨します。

【応用①】範囲内の図形だけをグループ化

Sub RngShpGroup()
'範囲内(rng)の図形をすべてグループ化
    On Error GoTo ErrorTrap '図形が1つだとエラーとなる
    Dim rng As Range: Set rng = Range("A1:Z20")
    Dim rightRng As Single: rightRng = rng.Left + rng.Width
    Dim bottomRng As Single: bottomRng = rng.Top + rng.Height
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        Dim shpRight As Single: shpRight = shp.Left + shp.Width
        Dim shpBottom As Single: shpBottom = shp.Top + shp.Height
        
        'shpがrng内か判定
        If rng.Left < shp.Left And rightRng > shpRight And _
           rng.Top < shp.Top And bottomRng > shpBottom Then
           shp.Select (False) 'False：複数選択可
        End If
    Next
    Selection.Group: Exit Sub
    
ErrorTrap:
    MsgBox "グループ化するには2つ以上のシェイプが必要です"
End Sub

上のプログラムではrngの範囲内にある図形だけをグループ化することができます。
このプログラムではサンプルとして具体的な範囲（A1：Z20）にしていますが、この範囲を変更しても使えます。

        'shpがrng内か判定
        If rng.Left < shp.Left And rightRng > shpRight And _
           rng.Top < shp.Top And bottomRng > shpBottom Then
           shp.Select (False) 'False：複数選択可
        End If

このIf文でshpがrng内に含まれるかどうか判定しています。

rngの上下左右の座標とshpの上下左右の座標をすべて取得することで内側にあるかどうか判定しています。