VBA 他人の書いたコードを読むには、プロシージャの呼び出しマップを作ってみる。

他人の書いたコードを読むのはなかなか難しい。
今回はプロシージャやモジュールが分かれているプログラムを読むときに使える手法「呼び出しマップ」を紹介する。

「呼び出しマップ」というのは私が勝手にそう呼んでいるだけなのだが、どのプロシージャがどのプロシージャを呼び出しているかを図式化したものである。

例えば以前作成した画像の重なり判定を行うマクロを例に挙げる。
これは、アクティブシートのシェイプの重なりを判定するマクロのコードで、実行すると、以下のように表示される。

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

判定結果を基に自動でグループ化させるようなマクロを作りたいときに部品として使った。

コード
呼び出しマップ
呼び出しマップを作るツール

コード

標準モジュール[Main]

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

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

標準モジュール[ShapeWrapperTypeDef]

'ShapeWrapperクラス用のユーザー定義型です。
Public Type Node
    x As Single
    y As Single
End Type

クラスモジュール[IShapeWrapper]

'ShapeWrapper用インターフェース
Public Function IsOverlapped(SW As ShapeWrapper) As Boolean
End Function
Public Property Get Self() As IShapeWrapper
End Property
Public Sub SetShape(s As Shape)
End Sub
Public Property Get Name() As String
End Property

クラスモジュール[ShapeWrapper]

Implements IShapeWrapper

Private InnerShape As Shape
Private Property Get IShapeWrapper_Self() As IShapeWrapper
    Set IShapeWrapper_Self = Me
End Property
Private Property Get IShapeWrapper_Name() As String
    IShapeWrapper_Name = InnerShape.Name
End Property
Private Sub IShapeWrapper_SetShape(s As Shape)
    Set InnerShape = s
End Sub
Public Property Get Top() As Single
    Top = InnerShape.Top
End Property
Public Property Get Bottom() As Single
    Bottom = InnerShape.Top + InnerShape.Height
End Property
Public Property Get Left() As Single
    Left = InnerShape.Left
End Property
Public Property Get Right() As Single
    Right = InnerShape.Left + InnerShape.Width
End Property
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
Private Function IShapeWrapper_IsOverlapped(SW As ShapeWrapper) As Boolean
    Dim i As Integer
    For i = 1 To 4 Step 1
        IShapeWrapper_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 IShapeWrapper_IsOverlapped Then Exit Function
    Next
End Function