種々のカラーパレット 3

記事「種々のカラーパレット 2」のつづき

「種々のカラーパレット 2」の最後では、
任意の色から黒までのグラデーションのカラーパレットに変更しました。
次は、白から任意の色、黒の順に変化するカラーパレットです。

白から任意の色、任意の色から黒までのグラデーションを
2つのFor文で行います。

Sub macro100221a()
'カラーパレットを変更
'単色濃淡グラデーション
'白から任意の色、そして黒

    '任意の色の設定
    Dim r0, g0, b0, r1, g1, b1 As Integer
    r0 = 136: g0 = 34: b0 = 67
   
    Dim i, r, g, b As Integer
    Dim MyIndex As Variant
    MyIndex = Array(1, 53, 52, 51, 49, 11, 55, 56, _
        9, 46, 12, 10, 14, 5, 47, 16, _
        3, 45, 43, 50, 42, 41, 13, 48, _
        7, 44, 6, 4, 8, 33, 54, 15, _
        38, 40, 36, 35, 34, 37, 39, 2)
       
        '白から任意の色へ
        For i = 0 To 19
            r = Int((255 - r0) * (19 - i) / 19) + r0
            g = Int((255 - g0) * (19 - i) / 19) + g0
            b = Int((255 - b0) * (19 - i) / 19) + b0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        '任意の色から黒へ
        For i = 20 To 39
            r = r0 - Int(r0 * (i - 19) / 20)
            g = g0 - Int(g0 * (i - 19) / 20)
            b = b0 - Int(b0 * (i - 19) / 20)
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
End Sub

変更後の白から任意の色、黒の順に変化するカラーパレットです。

単色濃淡グラデーションはこれくらいでやめます。
今度は、任意の色0から任意の色1までのグラデーションです。

任意の色0と任意の色1をRGB関数で表すと

RGB(r0, g0, b0)
RGB(r1, g1, b1)

にします。

引数Redについて説明します。

任意の色0から任意の色1までのグラデーションで引数Redは
r0 から r1 まで変化します。
i が0から39まで変化する間に
(r1 - r0)分だけ増えるようにするには、
(r1 - r0)を39等分して

(r1 - r0) / 39

これに i を掛けると(r1 - r0) / 39ずつ増えていきます。

(r1 - r0) / 39 * i

これが引数Redに入ります。

r = (r1 - r0) * i / 39

引数Green、Blueも同様です。

Sub macro100221b()
'カラーパレットを変更
'任意の色0から任意の色1のグラデーション

    '任意の色の設定
    Dim r0, g0, b0, r1, g1, b1 As Integer
    r0 = 136: g0 = 34: b0 = 67
    r1 = 23: g1 = 187: b1 = 149
   
    Dim i, r, g, b As Integer
    Dim MyIndex As Variant
    MyIndex = Array(1, 53, 52, 51, 49, 11, 55, 56, _
        9, 46, 12, 10, 14, 5, 47, 16, _
        3, 45, 43, 50, 42, 41, 13, 48, _
        7, 44, 6, 4, 8, 33, 54, 15, _
        38, 40, 36, 35, 34, 37, 39, 2)

        For i = 0 To 39
            r = r0 + Int((r1 - r0) * i / 39)
            g = g0 + Int((g1 - g0) * i / 39)
            b = b0 + Int((b1 - b0) * i / 39)
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
End Sub

変更後の任意の色0から任意の色1のカラーパレットです。

今度は、色相のグラデーションです。
赤、イエロー、緑、シアン、青、マゼンダ、
そして赤になっていくグラデーションのカラーパレットです。

赤からイエロー、
イエローから緑、
緑からシアン、
シアンから青、
青からマゼンダ、
マゼンダから赤の変化を
6つのfor文で分割して行います。

Sub macro100221c()
'カラーパレットを変更
'色相のグラデーション

    Dim i, r, g, b As Integer
    Dim MyIndex As Variant
    MyIndex = Array(1, 53, 52, 51, 49, 11, 55, 56, _
        9, 46, 12, 10, 14, 5, 47, 16, _
        3, 45, 43, 50, 42, 41, 13, 48, _
        7, 44, 6, 4, 8, 33, 54, 15, _
        38, 40, 36, 35, 34, 37, 39, 2)
       
        For i = 0 To 6
            r = 255
            g = Int(255 * i / 6)
            b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 7 To 13
            r = Int(255 - (255 * (i - 6) / 7))
            g = 255
            b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 14 To 20
            r = 0
            g = 255
            b = Int(255 * (i - 13) / 7)
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 21 To 27
            r = 0
            g = Int(255 - (255 * (i - 20) / 7))
            b = 255
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 28 To 34
            r = Int(255 * (i - 27) / 7)
            g = 0
            b = 255
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 35 To 39
            r = 255
            g = 0
            b = Int(255 - (255 * (i - 33) / 7))
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i

End Sub

変更後の色相のグラデーションカラーパレットです。

上の色相は鮮やかですが、
この色相のグラデーションを淡くしたり、
濃くしたグラデーションにしてみます。

RGB関数は、加法混色なので
ある色を淡くするには、
Red、Green、Blueに同量ずつ足します。
反対に暗くするには、
Red、Green、Blueに同量ずつ引きます。

この「同量」のところが下のコードの torn になります。
ようするに、上の色相のグラデーションのコードの
変数r、g、bに代入するところに「+ torn」を付け足しただけです。

ひとつ注意点があります。
RGB関数は、各引数が255を超えるとすべて255とみなしますが、
負の数を入れるとエラーになります。
引数が不正みたいです。

tornの値をマイナスにすると
RGB関数の各引数に入れる変数r、g、b が
マイナスになることもあります。
このような場合はすべて0にします。

Sub macro100221d()
'カラーパレットを変更
'色相のグラデーション
'トーン変化あり

    Dim i, r, g, b, torn As Integer
    Dim MyIndex As Variant
    MyIndex = Array(1, 53, 52, 51, 49, 11, 55, 56, _
        9, 46, 12, 10, 14, 5, 47, 16, _
        3, 45, 43, 50, 42, 41, 13, 48, _
        7, 44, 6, 4, 8, 33, 54, 15, _
        38, 40, 36, 35, 34, 37, 39, 2)
    'トーンの設定(-255≦torn≦255)
    '正の数で淡く、'負の数で暗くなる。
    torn = 200
   
        For i = 0 To 6
            r = 255 + torn
            g = Int(255 * i / 6) + torn
            b = 0 + torn
            If r < 0 Then r = 0
            If g < 0 Then g = 0
            If b < 0 Then b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 7 To 13
            r = Int(255 - (255 * (i - 6) / 7)) + torn
            g = 255 + torn
            b = 0 + torn
            If r < 0 Then r = 0
            If g < 0 Then g = 0
            If b < 0 Then b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 14 To 20
            r = 0 + torn
            g = 255 + torn
            b = Int(255 * (i - 13) / 7) + torn
            If r < 0 Then r = 0
            If g < 0 Then g = 0
            If b < 0 Then b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 21 To 27
            r = 0 + torn
            g = Int(255 - (255 * (i - 20) / 7)) + torn
            b = 255 + torn
            If r < 0 Then r = 0
            If g < 0 Then g = 0
            If b < 0 Then b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 28 To 34
            r = Int(255 * (i - 27) / 7) + torn
            g = 0 + torn
            b = 255 + torn
            If r < 0 Then r = 0
            If g < 0 Then g = 0
            If b < 0 Then b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 35 To 39
            r = 255 + torn
            g = 0 + torn
            b = Int(255 - (255 * (i - 33) / 7)) + torn
            If r < 0 Then r = 0
            If g < 0 Then g = 0
            If b < 0 Then b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i

End Sub

変更後のトーン変化色相グラデーションカラーパレットです。

ここでは、単純に引いたり足したりしているだけですので、
淡くしたり濃くしたりするのにもっといいやり方があるかもしれません。