【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 は “【ExcelVBA】ColorIndexの一覧を作成するマクロサンプル” について考えました