Excelテーブルから図形の色を変更し、社内の空調設備を視覚化する

目標

以下の状態を目指します。

• テーブル上の値に合わせて図形の色が変更される
• 図形をクリックしたときに図形の詳細が表示される

背景

社内の空調設備がどのように設定されているか可視化するため、平面図上に図形を置き、
エアコンの状態(暖房/冷房/送風)によって色を変化させること、
またエアコンの設定温度がわかるように、図をクリックしたときに設定温度をメッセージ表示したい
という要望がありました。

上記の例では一般的な住宅見取り図を使っているため数は少ないですが、本来は100個近くのエアコンを管理しています。
そのため、表に記入することでエアコンの状態遷移を表現します。
エアコンの設定温度等の詳細も表に記載して管理します。

Excelの設定

見取り図の上に図形を挿入します。
このとき図形には空間ごとに名前を設定します。

この図形の名前と、プロパティを設定するための辞書リストを作成します。
辞書リストはテーブルに設定することで、図形が増えた時に自動で拡張されます。

今回は辞書リスト1列目を図形名、2列目をエアコンの状態(暖房/冷房/送風/OFF)、4列目を図形クリックしたときのメッセージとします。

VBAの設定

全ての処理を1モジュール1プロシージャに集約したほうがコード量は短くなりますが、
今回はオブジェクト指向に則り、Shapeオブジェクトに関する処理はなるべくShapeExクラスに担当させます。

クラス モジュール

VBAの編集画面から挿入(I) > クラスモジュール(C)により以下のクラスを作成します。

ShapeEx(拡張Shapeクラス)

色変更、テキスト設定等の、本モジュール内でShapeに対する処理をまとめたクラスです。
DictionaryListColumnsEnum(辞書リストの列順)は実際の辞書リストに合わせて調整します。

ShapeEx.cls

Option Explicit

' このクラスの図形自身
Private This As Shape

' 色
Private Color As String

' 代替テキスト
Private AlterText As String

' 辞書リストに存在するか
Private m_DictionaryExists As Boolean

' 辞書リストの列順
Private Enum DictionaryListColumnsEnum
    ShapeName = 1
    Switch = 2
    Memo = 4
End Enum

' 初期化(辞書リストからプロパティを設定する)
Public Sub Init(shp As Shape, dictionaryList As ListObject)
    
    Set This = shp
    
    ' 辞書リストの1列目がこの図形自身の名前と一致するオートシェイプならプロパティ設定する
    Dim dataRow As ListRow
    For Each dataRow In dictionaryList.ListRows
        If shp.Name = dataRow.Range(DictionaryListColumnsEnum.ShapeName).Value Then
            m_DictionaryExists = True
            Color = dataRow.Range(DictionaryListColumnsEnum.Switch).Value
            AlterText = dataRow.Range(DictionaryListColumnsEnum.Memo).Value
        End If
    Next
    
End Sub

' 辞書リストに存在するか(読み取り専用プロパティ)
Public Property Get DictionaryExists() As Boolean
    DictionaryExists = m_DictionaryExists
End Property

' 図形の色を設定する
Public Sub SwitchColor()
    
    Select Case Color
        Case "暖房"
            This.Fill.ForeColor.RGB = RGB(255, 0, 0)
        Case "送風"
            This.Fill.ForeColor.RGB = RGB(0, 255, 0)
        Case "冷房"
            This.Fill.ForeColor.RGB = RGB(0, 0, 255)
        Case Else
            This.Fill.ForeColor.RGB = RGB(255, 255, 255)
    End Select
    
End Sub

' 図形に代替テキストを設定する
Public Sub SetAlternativeText()
    This.AlternativeText = AlterText
End Sub

' 図形にテキストを設定する
Public Sub SetText()
    This.TextFrame2.TextRange.Text = This.Name
End Sub

ShapeExCollection(ShapeExのコレクション)

このブックの中に存在する図形を全てShapeExとしてコレクションするクラス

ShapeExCollection.cls

Option Explicit

Public Items As Collection

Private Sub Class_Initialize()
    Set Items = New Collection
End Sub

' ShapeExコレクションの初期化
Public Sub Init(dictionaryList As ListObject)

    ' 全てのワークシート内の全てのオートシェイプに対し
    Dim sh As Worksheet
    Dim shp As Shape
    For Each sh In ThisWorkbook.Worksheets
        For Each shp In sh.Shapes
            ' 図形の拡張クラスを宣言し、辞書リストで初期化、辞書に存在すればコレクションに加える
            Dim exShp As New ShapeEx: exShp.Init shp, dictionaryList
            If exShp.DictionaryExists Then Items.Add exShp
            Set exShp = Nothing
        Next
    Next
    
End Sub

シート モジュール

辞書リストを更新した時に、図形の設定を更新するサブプロシージャを実行します。
このコードは辞書リストが入っているシートに記載します。

Sheet1.cls

Option Explicit

' テーブルの内容が変更された時のイベント
Private Sub Worksheet_Change(ByVal Target As Range)

    ' 2つ以上のセルが同時に変更された場合は終了する
    If Target.Count > 1 Then Exit Sub
    
    ' テーブル以外が編集された場合は終了する
    If Intersect(Target, Me.ListObjects(1).DataBodyRange) Is Nothing Then Exit Sub
    
    ' メソッドを呼び出す
    Call Me.RefreshShapes

End Sub

' 図形の設定を更新する
Sub RefreshShapes()

    ' 図形の拡張クラス(ShapeEx)のコレクションクラスを初期化
    Dim exShpCollection As New ShapeExCollection
    exShpCollection.Init Me.ListObjects(1)
    
    ' ShapeExのメソッドを呼び出す
    Dim exShp As ShapeEx
    For Each exShp In exShpCollection.Items
        Call exShp.SetAlternativeText
        Call exShp.SwitchColor
        Call exShp.SetText
    Next
    
End Sub

標準モジュール

見取り図上の全ての図形に以下のマクロを登録し、図形をクリックしたときにメッセージ表示します。

Application.CallerはVisual Basicを呼び出した方法によって異なる型を返すため、単体でDisplayMemo()を実行するとエラーになります。
そのためSelect Case TypeName(Application.Caller)を使い、どこから呼び出されたか判定します。

Module1.bas

Option Explicit

' 図形に設定してある代替テキストを表示する
Sub DisplayMemo()
    
    ' 図形をクリックして呼び出されたか判定する
    Select Case TypeName(Application.Caller)
    Case "String"
    
        ' Application.Callerを使い、このマクロがシート上の、どの図形から呼び出されたか見つける
        Dim shp As Shape: Set shp = ActiveSheet.Shapes(Application.Caller)
        
        ' 図形の代替テキストと図形の名前をメッセージ表示する
        MsgBox shp.AlternativeText, vbInformation, shp.Name
    
    Case Else
        MsgBox "図形以外から呼び出されたため、テキスト表示できません", vbCritical
    End Select
    
End Sub

本来はDisplayMemoメソッドはShapeExに実装するべきですが、図形クリックのたびにShapeExを初期化するために辞書リストを参照するのはメモリの無駄遣いと判断し、
図形に設定された代替テキストを表示する方式をとっています。

動作テスト

辞書リストでエアコンの状態(暖房/冷房/送風)を変更し、図形の色が変動することを確認します。
色が変わらない図形がある場合は図形名の綴りを見直します。

次に図形を右クリックして代替テキストを表示し、辞書リストと合致していることを確認します。

最後に図形をクリックしてマクロを呼び出し、代替テキストと合致していることを確認します。

その他ユースケース

テーブルの内容を変更することでエアコン以外にも

• 部屋ごとの混雑状況
• 部署ごとの電気の使用量
• 機械ごとのエラー率

等をグラフィカルに表示できます。