ColorIndex、Color色見本

簡単なことですが、マクロなどを作る時に利用したい色がどのColorIndex(値)なのか一覧表を作っておきましょう。

A列がIndex値、B列がその「色」です。

 ColorIndex色見本
(画像をクリックすると、このサンプルがダウンロードできます)

 このサンプルを作成したマクロの記述です。


'***************************************************************************************************
'   ColorIndex色見本                                            Module1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'03/11/20(1.00)新規作成
'04/02/24(1.01)初回修正
'20/02/22(1.10)*.xlsm化、他
'***************************************************************************************************
Option Explicit

'***************************************************************************************************
'   ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名　：TEST_ColorIndex
'* 機能　　：ColorIndex色見本作成
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年11月20日
'* 作成者　：井上　治
'* 更新日　：2020年02月22日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub TEST_ColorIndex()
    '-----------------------------------------------------------------------------------------------
    Dim intIndex As Integer                                         ' ColorIndex値
    Dim lngRow As Long                                              ' 行INDEX
    intIndex = 0
    lngRow = 1
    On Error GoTo TEST_EXIT
    ' 無限ループとして実行時エラーで終了させる
    Do
        lngRow = lngRow + 1
        Cells(lngRow, 2).Interior.ColorIndex = intIndex
        Cells(lngRow, 1).Value = intIndex
        intIndex = intIndex + 1
    Loop

'===================================================================================================
' エラー処理(=終了)
TEST_EXIT:
    MsgBox (intIndex - 1) & "まで完了しました。"
    Err.Clear
    On Error GoTo 0
End Sub

'----------------------------------------<< End of Source >>----------------------------------------
良い悪いは別として、ColorIndexがいくつまで有効か判らないことを前提として、実行時エラーが発生するまでintIndexを加算しながら塗りつぶしを行なう繰り返し処理を作成して見ました。

Color色見本

上記の「ColorIndex」は数十色でしたが、Excel2007以降(*.xlsx *.xlsm)では「Color」が使えます。

「Color」では256の3乗で1677万色が使えることになります。
しかし、これをセルに縦に並べるマクロを作る場合は行数限度が104万行であり、ブック内の固有セル書式数の限度が64,000という限度があるので、 3原色であるRGBを0から255までループさせながら組み合わせで色を作るのですが、 8ずつ間を飛ばすことにしました。
それでも36,000件近くになります。

 Color色見本
(画像をクリックすると、このサンプルがダウンロードできます)
特にマクロ起動ボタン等は用意していません。表示タブか開発タブの「マクロ」から実行させて下さい。
マクロは「MakeColorSample1」と「MakeColorSample2」の2つがあります。 「MakeColorSample2」の方は三原色ループ処理のままに順番で、「MakeColorSample1」の方は薄い色から並べようと RGB値を掛け合わせた値が大きい方から並べ替えています。
マクロで色見本を作成したファイルを保存させると1.6MB程度になります。

 このサンプルを作成したマクロの記述です。
実際に「0から255まで」と記述させてしまうと黒い方から始まってしまうので、 「255から0まで8ずつ減算」としています。


'***************************************************************************************************
'   Color色見本作成                                                     Module1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'19/05/29(1.00)新規作成
'19/06/01(1.01)エラー処理実装､最終RGB値=0の処理を追加
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle As String = "Color色見本作成"
Private Const g_cnsValueFrom As Integer = 255                       ' RGBループ初期値
Private Const g_cnsValueTo As Integer = 0                           ' RGBループ終了値
Private Const g_cnsValuePitch As Integer = -8                       ' RGBループ間隔

'***************************************************************************************************
'   ■■■ Color色見本作成 ■■■
'***************************************************************************************************
'* 処理名　：MakeColorSample1
'* 機能　　：Color色見本作成①(薄い色から順に並替え)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年06月01日
'* 作成者　：井上　治
'* 更新日　：2019年06月01日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub MakeColorSample1()
    '-----------------------------------------------------------------------------------------------
    ' Color色見本作成(サブ処理、並替え有り)
    Call GP_MakeColorSampleSub(True)
End Sub

'***************************************************************************************************
'* 処理名　：MakeColorSample2
'* 機能　　：Color色見本作成②(並替え無し)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年06月01日
'* 作成者　：井上　治
'* 更新日　：2019年06月01日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub MakeColorSample2()
    '-----------------------------------------------------------------------------------------------
    ' Color色見本作成(サブ処理、並替え無し)
    Call GP_MakeColorSampleSub(False)
End Sub

'***************************************************************************************************
'   ■■■ サブ処理 ■■■
'***************************************************************************************************
'* 処理名　：GP_MakeColorSampleSub
'* 機能　　：Color色見本作成(サブ処理)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = ソート指定(Boolean)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年06月01日
'* 作成者　：井上　治
'* 更新日　：2019年06月01日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub GP_MakeColorSampleSub(ByVal blnSort As Boolean)
    '-----------------------------------------------------------------------------------------------
    Dim objSh As Worksheet                                          ' Worksheet
    Dim lngRow As Long                                              ' 行INDEX
    Dim intR As Integer                                             ' Red値
    On Error GoTo MakeColorSample_ERROR
    ' 画面描画停止
    Call GP_StopScreen
    Set objSh = ThisWorkbook.Worksheets(1)
    lngRow = 1
    '-------------------------------------------------------
    ' Redのループ
    For intR = g_cnsValueFrom To g_cnsValueTo Step g_cnsValuePitch
        ' Color色見本作成(Redサブ処理)
        Call GP_MakeColorSampleRed(objSh, lngRow, intR)
    Next intR
    ' Color色見本作成(Redサブ処理、Red=0)
    Call GP_MakeColorSampleRed(objSh, lngRow, 0)
    '-------------------------------------------------------
    ' 並替え指定
    If Not blnSort Then
        With objSh
            ' E列降順で並替え
            .Range(.Cells(2, 1), .Cells(lngRow, 6)).Sort Key1:=.Cells(2, 6), _
                                                         Order1:=xlDescending, _
                                                         Header:=xlNo, _
                                                         Orientation:=xlTopToBottom
        End With
    End If
    GoTo MakeColorSample_EXIT

'===================================================================================================
' 実行時エラー処置
MakeColorSample_ERROR:
    MsgBox Err.Description, vbCritical, g_cnsTitle
'===================================================================================================
' 終了
MakeColorSample_EXIT:
    On Error GoTo 0
    ' 画面描画再開
    Call GP_StartScreen
    ThisWorkbook.Saved = True
End Sub

'***************************************************************************************************
'* 処理名　：GP_MakeColorSampleRed
'* 機能　　：Color色見本作成(Redサブ処理)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = Worksheet(Object)
'* 　　　　　Arg2 = 行(Long)                            ※Ref参照
'* 　　　　　Arg3 = Red値(Integer)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年06月01日
'* 作成者　：井上　治
'* 更新日　：2019年06月01日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub GP_MakeColorSampleRed(ByRef objSh As Worksheet, _
                                  ByRef lngRow As Long, _
                                  ByVal intR As Integer)
    '-----------------------------------------------------------------------------------------------
    Dim intG As Integer                                             ' Green値
    ' Greenのループ
    For intG = g_cnsValueFrom To g_cnsValueTo Step g_cnsValuePitch
        ' Color色見本作成(Greenサブ処理)
        Call GP_MakeColorSampleGreen(objSh, lngRow, intR, intG)
    Next intG
    ' Color色見本作成(Greenサブ処理、Green=0)
    Call GP_MakeColorSampleGreen(objSh, lngRow, intR, 0)
End Sub

'***************************************************************************************************
'* 処理名　：GP_MakeColorSampleGreen
'* 機能　　：Color色見本作成(Greenサブ処理)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = Worksheet(Object)
'* 　　　　　Arg2 = 行(Long)                            ※Ref参照
'* 　　　　　Arg3 = Red値(Integer)
'* 　　　　　Arg4 = Green値(Integer)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年06月01日
'* 作成者　：井上　治
'* 更新日　：2019年06月01日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub GP_MakeColorSampleGreen(ByRef objSh As Worksheet, _
                                    ByRef lngRow As Long, _
                                    ByVal intR As Integer, _
                                    ByVal intG As Integer)
    '-----------------------------------------------------------------------------------------------
    Dim intB As Integer                                             ' Blue値
    ' Blueのループ
    For intB = g_cnsValueFrom To g_cnsValueTo Step g_cnsValuePitch
        ' 背景色セット
        Call GP_SetColor(objSh, lngRow, intR, intG, intB)
    Next intB
    ' 背景色セット(Blue=0)
    Call GP_SetColor(objSh, lngRow, intR, intG, 0)
End Sub

'***************************************************************************************************
'* 処理名　：GP_SetColor
'* 機能　　：背景色セット
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = Worksheet(Object)
'* 　　　　　Arg2 = 行(Long)                            ※Ref参照
'* 　　　　　Arg3 = Red値(Integer)
'* 　　　　　Arg4 = Green値(Integer)
'* 　　　　　Arg5 = Blue値(Integer)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年06月01日
'* 作成者　：井上　治
'* 更新日　：2019年06月01日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub GP_SetColor(ByRef objSh As Worksheet, _
                        ByRef lngRow As Long, _
                        ByVal intR As Integer, _
                        ByVal intG As Integer, _
                        ByVal intB As Integer)
    '-----------------------------------------------------------------------------------------------
    Dim lngColor As Long                                            ' Color値
    Dim lngSort As Long                                             ' SortKey
    lngRow = lngRow + 1
    lngColor = RGB(intR, intG, intB)
    lngSort = CLng(intR) * CLng(intG) * CLng(intB)
    With objSh
        .Cells(lngRow, 1).Value = intR                              ' Red値
        .Cells(lngRow, 2).Value = intG                              ' Green値
        .Cells(lngRow, 3).Value = intB                              ' Blue値
        .Cells(lngRow, 4).Interior.Color = lngColor                 ' 背景色
        .Cells(lngRow, 5).Value = lngColor                          ' RGB値(Long)
        .Cells(lngRow, 6).Value = lngSort                           ' SortKey
    End With
End Sub

'------------------------------------------<< End of Source >>--------------------------------------
このような長いソースになってしまいました。(画面描画制御の共通処理は省略しています)

処理の理屈としては、 

Sub TEST()
    Dim intR As Integer                                             ' Red値
    Dim intG As Integer                                             ' Green値
    Dim intB As Integer                                             ' Blue値
    ' Red値のループ
    For intR = 255 To 0 Step -8
        ' Green値のループ
        For intG = 255 To 0 Step -8
            ' Blue値のループ
            For intB = 255 To 0 Step -8
                '    ・
                '    ・
                ' ここで背景色等をセルにセット
                '    ・
                '    ・
            Next intB
        Next intG
    Next intR
End Sub
このようなことであって1つのプロシージャでできるはずだったのですが、 255から順に8ずつ差し引いていくと、0には到達しないので7で終わってしまいます。 7でも見た目は充分に黒いのですが、念のためループの後で値0の処理を追加しています。

 これを1プロシージャで書くと、 

Sub TEST()
    Dim intR As Integer                                             ' Red値
    Dim intG As Integer                                             ' Green値
    Dim intB As Integer                                             ' Blue値
    ' Red値のループ
    For intR = 255 To 0 Step -8
        ' Green値のループ
        For intG = 255 To 0 Step -8
            ' Blue値のループ
            For intB = 255 To 0 Step -8
                '    ・
                ' ここで背景色等をセルにセット
                '    ・
            Next intB
            ' Blue値=0の処置
            intB = 0
            '    ・
            ' ここで背景色等をセルにセット
            '    ・
        Next intG
        ' Green値=0の処置
        intG = 0
        ' Blue値のループ
        For intB = 255 To 0 Step -8
            '    ・
            ' ここで背景色等をセルにセット
            '    ・
        Next intB
    Next intR
    ' Red値=0の処置
    intR = 0
    ' Green値のループ
    For intG = 255 To 0 Step -8
        ' Blue値のループ
        For intB = 255 To 0 Step -8
            '    ・
            ' ここで背景色等をセルにセット
            '    ・
        Next intB
        ' Blue値=0の処置
        intB = 0
        '    ・
        ' ここで背景色等をセルにセット
        '    ・
    Next intG
    ' Green値=0の処置
    intG = 0
    ' Blue値のループ
    For intB = 255 To 0 Step -8
        '    ・
        ' ここで背景色等をセルにセット
        '    ・
    Next intB
End Sub
このようになって重複した記述が多数できてしまうことから、重複部分を別プロシージャに分けたのが元のソースになります。

 所望する色を見つけて実際にソースコードに利用する場合は「Long値(E列)」の値を使います。

    Range("$A$1").Interior.Color = 2621439
といった形です。(このサンプルは背景色になります)