【EXCEL VBA】条件によって複数の図形（オブジェクト）の色を変えるマクロの作り方

EXCELで複数のセルの値に応じて、それぞれのセルに対応する図形の色を変更する必要があったため、作ってみました。

1つのセルの値を変更して、1つの図形の色を変更する方法は検索すればすぐにヒットしたのですが、それを複数のセルに応用しようとしてもなかなかうまくいきませんでしたが、標準モジュールにマクロを書いてWorksheet_changeでCallする方法を思いつたいので、備忘録として書きます。

ちなみに、単一セルの図形の色変更は下記を参考にしました。

detail.chiebukuro.yahoo.co.jp
ja.extendoffice.com

完成したイメージはこんな感じです。
f:id:yohsuke517:20211119143533g:plain

早速、作り方をご紹介します。
f:id:yohsuke517:20211119143203p:plain

こんな感じで、それぞれの画像の色を入力する項目を作り、画像にはそれぞれShape1～Shape3と名前をつけておきます。
次に、標準モジュールに次のコードを記入します。

Sub Shapes_Color_Change1()

    With Sheets("Sheet1")
    
        If Range("C3").Value = "赤" Then
            .Shapes("Shape1").Fill.ForeColor.RGB = vbRed
        ElseIf Range("C3").Value = "青" Then
            .Shapes("Shape1").Fill.ForeColor.RGB = vbBlue
        ElseIf Range("C3").Value = "黄" Then
            .Shapes("Shape1").Fill.ForeColor.RGB = vbYellow
        Else
            .Shapes("Shape1").Fill.ForeColor.RGB = vbWhite
        End If
        
        If Range("C4").Value = "赤" Then
            .Shapes("Shape2").Fill.ForeColor.RGB = vbRed
        ElseIf Range("C4").Value = "青" Then
            .Shapes("Shape2").Fill.ForeColor.RGB = vbBlue
        ElseIf Range("C4").Value = "黄" Then
            .Shapes("Shape2").Fill.ForeColor.RGB = vbYellow
        Else
            .Shapes("Shape2").Fill.ForeColor.RGB = vbWhite
        End If
         
        If Range("C5").Value = "赤" Then
            .Shapes("Shape3").Fill.ForeColor.RGB = vbRed
        ElseIf Range("C5").Value = "青" Then
            .Shapes("Shape3").Fill.ForeColor.RGB = vbBlue
        ElseIf Range("C5").Value = "黄" Then
            .Shapes("Shape3").Fill.ForeColor.RGB = vbYellow
        Else
            .Shapes("Shape3").Fill.ForeColor.RGB = vbWhite
        End If
        
    End With
    
End Sub

C3からC5に「赤」「青」「黄」を入力するとその色になり、それ以外(空欄含む)なら白になるようにしています。

次に、セルの値を変更した瞬間に図形の色を変更するために、Worksheet_changeに上記のマクロを呼び出すコードを書きます。
方法は、シート名を右クリックし、「コードの表示」をクリックします。
f:id:yohsuke517:20211119144004p:plain

マクロの編集画面が出るので、そこに下記のコードを貼り付けます。

Private Sub Worksheet_Change(ByVal Target As Range)

Call Shapes_Color_Change1

End Sub

これで完成です。
あとはセルの値を入力したり消したりするだけで、自動で画像の色が変わるはずです。
この方法だと、Sheet1のどこかのセルの値を変更するたびにShapes_Color_Change1の処理が始まるので、非効率と言えば非効率ですが、僕は本職のプログラマではないので、とりあえず動けばＯＫです(笑)
もっと効率的な方法があったら、ぜひ教えてください。

余談ですが、もっと細かく色の指定をしてみたくなったので、さらに工夫してRGB値を指定して色を変えるマクロも組んでみました。
f:id:yohsuke517:20211119144511g:plain

参考までに一応コードも載せておきます。

Sub Shapes_Color_Change()

Dim R1 As Long, G1 As Long, B1 As Long 'Shape1のRGBそれぞれの値を格納する変数
Dim R2 As Long, G2 As Long, B2 As Long 'Shape2のRGBそれぞれの値を格納する変数
Dim R3 As Long, G3 As Long, B3 As Long 'Shape3のRGBそれぞれの値を格納する変数
    
    
    On Error Resume Next 'worksheetfunction.vlookupを使っているので念のため
    
    
    '図形1のRGB値の取得
    R1 = WorksheetFunction.VLookup(Range("C3"), Range("B11:E16"), 2, 0)
    G1 = WorksheetFunction.VLookup(Range("C3"), Range("B11:E16"), 3, 0)
    B1 = WorksheetFunction.VLookup(Range("C3"), Range("B11:E16"), 4, 0)
    
    '図形2のRGB値の取得
    R2 = WorksheetFunction.VLookup(Range("C4"), Range("B11:E16"), 2, 0)
    G2 = WorksheetFunction.VLookup(Range("C4"), Range("B11:E16"), 3, 0)
    B2 = WorksheetFunction.VLookup(Range("C4"), Range("B11:E16"), 4, 0)
   
    '図形3のRGB値の取得
    R3 = WorksheetFunction.VLookup(Range("C5"), Range("B11:E16"), 2, 0)
    G3 = WorksheetFunction.VLookup(Range("C5"), Range("B11:E16"), 3, 0)
    B3 = WorksheetFunction.VLookup(Range("C5"), Range("B11:E16"), 4, 0)
    
    
    'それぞれのShapeの塗りつぶしの色をRx,Gx,Bxの値に変更する
    With Sheets("Sheet1")
    
        .Shapes("Shape1").Fill.ForeColor.RGB = RGB(R1, G1, B1)
        .Shapes("Shape2").Fill.ForeColor.RGB = RGB(R2, G2, B2)
        .Shapes("Shape3").Fill.ForeColor.RGB = RGB(R3, G3, B3)

    End With
    
End Sub

あとは同じようにWorksheet_Changeで上記のマクロをCallするだけです。

EXCEL VBAは本とネット検索だけの独学なので、コードの書き方などはめちゃくちゃで読みづらく効率の悪い書き方かもしれませんが、参考になれば幸いです。

Hello! Mr.Simplism

僕の人生補完計画

【EXCEL VBA】条件によって複数の図形（オブジェクト）の色を変えるマクロの作り方