VBA クラスモジュールを使用し、シェイプ同士が重なっているかどうかを判定する方法

マクロ作成の背景

先日、Excelで作成したマニュアルを自動でWord化するマクロを書いた。
thom.hateblo.jp

しかしこのマクロは、シェイプの重なりには対応していない。

マニュアル作成などでは、Pictureの一部を赤枠で囲ったりする。

先日作ったマクロではオートシェイプが画像と無関係に張り付いてしまう。

そこで、あらかじめ画像をグループ化しておけば良いのではないかと気づいたのだが、これがまた手でやるとすこぶる面倒くさい。重なっているかどうか自動で判定して、勝手にグループ化してくれたらいいのに。

というのが今回の重なり判定作成の背景である。

今回の記事でやること

今回の記事では、VBAでシート上のシェイプをすべて走査してどのシェイプと重なっているかを表示させるところまでを紹介する。
具体的なグループ化については今のところまだ完成していないので取り扱わないが、今回の記事がスラスラ理解できるレベルの方なら、恐らくご自身でも続きは作れると思う。

判定の方法

重なっているというのは、どういう状態か。とりあえず今回は四角形に限定して考えてみることにした。すると、どんな重なり方も次の3パターンに分類できることが分かった。

A：完全に内側にある。
B：一部が重なっている。
C：十字型にまたがっている。

このうちAとBは、4つの頂点のどれかひとつが相手の画像の範囲内にあれば重なっていると見なせる。

Cだけは頂点で判定できず、左右の辺が図形の内側に、上下の辺が図形の外側にあるというのが条件になる。

ではこういう重なり方はどうだろう。

これはもう、Bの逆パターンと見なすことができるので、頂点で判定可能になる。

やはり、十字にまたがるケースだけが特殊なのだ。
今回のマクロでは、十字にまたがるCパターンは切り捨てることにした。これは単に私が扱う対象のマニュアルに十字型にまたがって重なっているシェイプがほとんど無かったからである。

なお、楕円のような特殊なケースも考慮しない。たとえば次の場合は重なっているとみなす。

楕円自体はたしかに四角形に接していないが、ゲームの当たり判定を作るわけではないのでそこまで正確な判定は必要としない。シェイプのTop、Left、Width、Heightといった属性を使って頂点を扱うので、三角形も円もすべて四角形として扱う。

BottomとRightが欲しい！

Shapeの位置を表すプロパティには、Top、Leftがある。これで左上の頂点のXとYは簡単に求まる。
しかし、それ以外の頂点の座標を取得するのはやや面倒くさい。
右上なら、TopとLeft+Width
左下なら、Top+HeightとLeft
右下なら、Top+HeightとLeft+Width
となる。

単純な計算ではあるが、メインコードの中に何度も繰り返し現れると鬱陶しい。時々Top+Widthなんていう書き間違いもする。

プログラミングするときはロジックの組み立てにかなり脳のリソースを使うので、こういう小さなことでも結構ストレスになる。些細なことに気を取られず、メインのロジックに集中したいのだ。

そこで、直接BottomやRightを扱えるように、クラスモジュールで対応することにした。

ラッパークラスを作る

Wrapperとは、「包む者」という意味である。ここでは、すでに存在するオブジェクトを包み込んで別の形で提供するために使用する。

クラスモジュールを追加し、ShapeWrapperという名称に変更する。
コードは以下のとおり。まずは簡単なところだけ実装してみた。

Private InnerShape As Shape

Public Property Get Name() As String
    Name = InnerShape.Name
End Property

Public Sub SetShape(s As Shape)
    Set InnerShape = s
End Sub

Public Property Get Top() As Single
    Top = InnerShape.Top
End Property

Public Property Get Left() As Single
    Left = InnerShape.Left
End Property

Public Property Get Bottom() As Single
    Bottom = InnerShape.Top + InnerShape.Height
End Property

Public Property Get Right() As Single
    Right = InnerShape.Left + InnerShape.Width
End Property

使い方は、SetShapeメソッドにシェイプをセットしてから各プロパティを取得するだけだ。
TopとLeftはセットしたシェイプのものを直接返しているが、BottomとRightは元のシェイプには無いので計算で求めている。

ShapeWrapperを使用する標準プロシージャのコードはこちら。

Sub hoge()
    Dim x As New ShapeWrapper
    x.SetShape ActiveSheet.Shapes(1)
    Debug.Print x.Name
    Debug.Print "Top: "; x.Top
    Debug.Print "Bottom: "; x.Bottom
    Debug.Print "Left: "; x.Left
    Debug.Print "Right: "; x.Right
End Sub

このように、Shapeオブジェクトを包むShapeWrapperを作成することで、メインコード側に便利な機能を提供することができる。ラッパークラスで提供しないメソッドはメインからは使えないので、例えばWidthやHeightを取得することはできない。
今回は特に公開の必要は無いが、必要であれば実装するか、InnerShapeをPublicにして外部公開してしまえば良い。

頂点の取得

さて、次は頂点を取得できるようにしたい。
頂点にはX座標とY座標があるので、できればまとめて取り扱えるようにすると便利だ。

そこでユーザー定義型を作成することにした。
標準モジュールを追加し、ShapeWrapperTypeDefという名称に変更する。
それから次のコードを張り付ける。

Public Type Node
    x As Single
    y As Single
End Type

それから、ShapeWrapperクラスにNodesプロパティを追加する。

Public Property Get Nodes(Number As Integer) As Node
    Select Case Number
        Case 1
            Nodes.x = Me.Left
            Nodes.y = Me.Top
        Case 2
            Nodes.x = Me.Right
            Nodes.y = Me.Top
        Case 3
            Nodes.x = Me.Right
            Nodes.y = Me.Bottom
        Case 4
            Nodes.x = Me.Left
            Nodes.y = Me.Bottom
        Case Else
            Err.Raise 1000, , "1~4を指定してください。"
    End Select
End Property

メインコードは次のように書き換える。

Sub hogehoge()
    Dim x As New ShapeWrapper
    x.SetShape ActiveSheet.Shapes(1)
    Debug.Print x.Name
    Debug.Print "左上座標: "; x.Nodes(1).x; ", "; x.Nodes(1).y
    Debug.Print "右上座標: "; x.Nodes(2).x; ", "; x.Nodes(2).y
    Debug.Print "右下座標: "; x.Nodes(3).x; ", "; x.Nodes(3).y
    Debug.Print "左下座標: "; x.Nodes(4).x; ", "; x.Nodes(4).y
End Sub

上のコードではNodesプロパティに番号を指定してNodeを取得し、その要素xとyをそれぞれ出力している。出力結果は次のとおり。

Picture 1
左上座標:  48 ,  13.2 
右上座標:  378.0286 ,  13.2 
右下座標:  378.0286 ,  332.4277 
左下座標:  48 ,  332.4277 

重なり判定

いよいよ重なり判定を作成する。

といっても材料はそろっているので、あとはそれぞれの頂点について調べれば良いだけである。

クラスモジュールShapeWrapperに以下を追記する。

Public Function IsOverlapped(SW As ShapeWrapper) As Boolean
    Dim i As Integer
    For i = 1 To 4 Step 1
        IsOverlapped = _
            (SW.Nodes(i).x > Me.Left And _
            SW.Nodes(i).x < Me.Right And _
            SW.Nodes(i).y > Me.Top And _
            SW.Nodes(i).y < Me.Bottom) _
            Or _
            (Me.Nodes(i).x > SW.Left And _
            Me.Nodes(i).x < SW.Right And _
            Me.Nodes(i).y > SW.Top And _
            Me.Nodes(i).y < SW.Bottom)
        If IsOverlapped Then Exit Function
    Next
End Function

これは、別のShapeWrapperを引数にとり、自身と重なっているかどうかの判定を返すプログラムだ。

メインコードは次のとおり。

Sub hogehogehoge()
    Dim SW1 As New ShapeWrapper
    SW1.SetShape ActiveSheet.Shapes(1)
    Dim SW2 As New ShapeWrapper
    SW2.SetShape ActiveSheet.Shapes(2)
    Debug.Print SW1.Name
    Debug.Print SW2.Name
    Debug.Print SW1.IsOverlapped(SW2)
End Sub

実行すると次のように表示された。

Picture 1
Rectangle 4
True

※つまり、Picture 1とRectangle 4は重なっているということ。

Rectangle4を除けて実行すると結果はFalseになる。

全シェイプの走査

個別の判定ができたら、あとは簡単だ。
全シェイプをShapeWrapperで包んでコレクションに入れ、ループで回しながら比較すれば良い。

以下は標準モジュールに書くメインコード。

Sub Shapeの重なり判定()
    'シェイプをShapeWrapperで包んでコレクションに追加
    Dim C As New Collection, s As Shape, SW1 As ShapeWrapper
    For Each s In ActiveSheet.Shapes
        Set SW1 = New ShapeWrapper
        SW1.SetShape s
        C.Add SW1
    Next

    'コレクションの各シェイプ同士の重なり判定
    Dim SW2 As ShapeWrapper
    For Each SW1 In C
        Debug.Print SW1.Name
        For Each SW2 In C
            If Not (SW1 Is SW2) Then
                If SW1.IsOverlapped(SW2) Then
                    Debug.Print vbTab & SW2.Name & "と重なっている"
                End If
            End If
        Next
    Next
End Sub

結果は次のとおり。

Picture 1
    Rectangle 4と重なっている
    Rectangle 5と重なっている
Rectangle 4
    Picture 1と重なっている
Rectangle 5
    Picture 1と重なっている

うまくいったようだ。

所感

今回はラッパークラスを用いてShapeオブジェクトにいろいろと便利な機能を付け加えたが、もしVBAにクラスモジュールが無かったら今回の計算を全てメインコード側で処理しないといけなくなる。これでは相当メインコードがごちゃごちゃしてしまう。

オブジェクト指向なんて使わなくても、関数で分割すればメインコードは膨らまないじゃないかと思う方も居るかもしれない。
でも関数を作って分割するにしても、関数どうしの関連性を結びつけるものや関数とデータを結びつけるものが無いのでそうしたことを自分で覚えておかないといけなくなる。

オブジェクト指向なら、データと関数をオブジェクトとしてひとまとめにしておけるし、使うときはオブジェクト変数にドットをつければプロパティとメソッドの一覧が表示され、どういった操作ができるのかが明確である。

やはりオブジェクト指向は偉大なり。と今回改めて実感した。

課題

今回のやり方はまだ完璧じゃない。
Top、Bottom、Left、RightとNodesプロパティはメインコードには登場しないが、メンバー一覧には表示されてしまうので少し煩わしい。

ただ、Private属性にしてしまうとIsOverlappedで引数に渡したShapeWrapperオブジェクトのプロパティが取得できなくなる。
この課題はインターフェースを使うことで改善できる。

インターフェースはポリモーフィズムのために使用されることが多いが、ユーザーにどの機能を見せるかをコントロールできるという利点もある。他の言語ではもっとうまいやり方があるのかもしれないが、VBAのクラスメンバーにはPublic、Friend、Privateの3種類しかない。今回のようにオブジェクト同士はやりとりするが、プログラマーには見せたくないといった場合、インターフェースを使えば見せる機能を限定できる。

じつはもう手元のコードでは改善したのだが。。

紹介となるとまたすこぶる説明がややこしいので今回はやめておく。

インターフェース関連の記事も過去に書いているので、興味があればどうぞ。
thom.hateblo.jp
thom.hateblo.jp

以上