【ExcelVBA】ColorIndexの一覧を作成するマクロサンプル

ExcelVBAで背景色や文字色をColorIndexで指定する場合に、何番が何色なのか判らなかったので、ColorIndexの一覧を作成するマクロを作成してみた。
シート名はデフォルト名になっているので、適当な名前に修正して欲しい。
Sub CreateColorIndexList() Dim mRow, nRow, nIndex, mIndex As Integer Dim mColor, nColor, nR, nG, nB As Long ' RGB値 mColor = &HFF ’ 色の最大値(255) mIndex = 56 ' ColorIndexの最大は56だって nRow = 2 ' データ部分の最初の行 With Sheets("Sheet2") ' シート名は適当な名前に修正すること ' ヘッダ作成 .Cells(1, 1).Value = "No." .Cells(1, 2).Value = "Color" .Cells(1, 3).Value = "RGB値" .Cells(1, 4).Value = "RGB()" ' リスト作成 For nIndex = 1 To mIndex .Cells(nRow, 1).Value = nIndex ' Index No. .Cells(nRow, 2).Interior.ColorIndex = nIndex ' 背景色を設定 nColor = .Cells(nRow, 2).Interior.Color ' 背景色のRGB値を取得 .Cells(nRow, 3).Value = nColor ' RGB値(Long)を設定 nR = nColor And mColor ' Long値をRGBに分解(Bit演算) nG = (nColor \ (2 ^ 8)) And mColor nB = nColor \ (2 ^ 16) .Cells(nRow, 4) = Str(nR) & ", " & Str(nG) & ", " & Str(nB) ' RGBを設定 .Cells(nRow, 2) = ZHex(nR) & ", " & ZHex(nG) & ", " & ZHex(nB) ' 16進数を設定 nRow = nRow + 1 ' 次の行 Next nIndex End With End Sub ’ 16進数文字に変換(一桁になる場合は、先頭に"0"を追加) Function ZHex(ByVal nColor As Long) As String ZHex = Right("0" & Hex(nColor), 2) End Function
※2018/09/20 Color列にColorCode(16進数)の出力を追加
こんな感じ。
途中で、RGBのLong値を、R,G,Bそれぞれの値に分割しているところは、Bit演算で処理している。
RGBのLong値の構成は、16進数表現だと「33 CC FF」のように6桁で構成されていて、左から2桁ずつ順番に「B」「G」「R」の値となっている。(RGBで指定するのとは逆順であることに注意)
そこで、Bit演算を利用して、以下のようなことをやっている。
RGB | Code | 処理内容(桁が判るよう16進数値「33CCFF」を例にする) |
R | nR = nColor And &HFF | RGB値に[00][00][FF]をAndすることで、最後の[FF]だけを取り出す |
G | nG = (nColor \ (2 ^ 8)) And &HFF | 1) RGB値を8 Bit分右にシフト(「\(2^8)」の部分)して、最後の[FF]を削除 2) RGB値は[33][CC]となる 3) RGB値[33][CC]に[00][FF]をANDして、[CC]のみを取り出す |
B | nB = nColor \ (2 ^ 16) | RGB値を16 Bit分右にシフト(「\2^16」の部分)することで、[33]のみを取り出す |
1 thought on “【ExcelVBA】ColorIndexの一覧を作成するマクロサンプル”