Rangeの範囲指定まとめ

注意点は、Rangeの中でCellsを使うとき

Range(Cells(2, 3))

とできない。セル(2, 3)だけ指定したくても

Range(Cells(2, 3), Cells(2, 3))

こうしないとエラーになる。

また、1行だけ、1列だけの選択をRangeでしたいときも

Range("A")
Range("1")

はエラーになるので

Range("A:A")
Range("1:1")

とする。

Sub macro100228a()
'選択範囲指定いろいろ
'F8キーで一行ずつ実行できます。

'単一セルを選択
    Cells(1, 1).Select
    Range("A2").Select
    Range(Cells(3, 1), Cells(3, 1)).Select
   
'複数のセルを選択
    Range("A1:C3").Select
    Range(Cells(1, 1), Cells(5, 5)).Select
   
'離れたセルを選択
    Range("A1:A3,C1:C3").Select
    Range("A1:A3,C1:C3,E1:E3").Select
'1行を選択
    Rows(1).Select
    Range("1:1").Select
   
'複数行を選択
    Rows("1:3").Select
    Range("1:6").Select

'離れた行を選択
    Range("1:1,3:3").Select
    Range("1:6,8:13").Select
   
'１列を選択
    Columns("A").Select
    Range("C:C").Select
   
'複数列を選択
    Columns("A:C").Select
    Range("A:E").Select
   
'離れた列を選択
    Range("A:A, C:C").Select
    Range("A:B, D:E").Select
   
End Sub

今度は、R1C1形式で範囲を指定します。

実行前に
記事「R1C1形 式をA1形式に変換する」の中の
toA1ファンクションプロシージャを
標準モジュールにコピペしてください。

Sub macro100228b()
'選択範囲指定いろいろ、R1C1形式で選択
'まず、toA1ファンクションプロシージャを
'標準モジュールにコピペしてください｡
'https://yumem.cocolog-nifty.com/blog/2009/12/r1c1a1-17ac.html
'一番最初だけF8キーを押す。
'次からは、Shift + F8のステップオーバーで実行

'単一セルを選択
    Range(toA1("R1C1")).Select

'複数のセルを選択
    Range(toA1("R1C1:R3C3")).Select
   
'離れたセルを選択
    Range(toA1("R1C1:R3C1, R1C3:R3C3")).Select
   
'1行を選択
    Rows(toA1("R1")).Select
    Range(toA1("R3")).Select
   
'複数行を選択
    Rows(toA1("R1:R3")).Select
    Range(toA1("R1:R6")).Select
   
'離れた行を選択
    Range(toA1("R1,R3")).Select
    Range(toA1("R2,R4")).Select
   
'１列を選択
    Columns(toA1("C1")).Select
    Range(toA1("C3")).Select
   
'複数列を選択
    Columns(toA1("C1:C3")).Select
    Range(toA1("C3:C5")).Select
   
'離れた列を選択
    Range(toA1("C1,C3")).Select
    Range(toA1("C1:C2,C4:C5")).Select
   
End Sub

任意の色とその補色

記事「色を反転する」の中で
パソコンソフトのイラストレーターの機能「反転」について
書きました。
「反転」という機能の下に
「補色」という機能が付いています。

この「補色」は、どんな仕組みになっているか調べてみました。

まずは、分かっていること…
赤の補色がシアンになることを確かめる。

RGB(255, 0, 0) → RGB(0, 255, 255)

これは、「反転」と同じ結果です。

次に、R255に加えてG100を加えてみる。

RGB(255, 100, 0) → RGB(0, 155, 255)

これも、「反転」と同じ結果です。

今度は、R255G100に加えてB50も加えてみる。

RGB(255, 100, 50) → RGB(50, 205, 255)

これは、「反転」と違います。
なぜなら、
赤が255 + 50 =305、
緑が100 + 205 = 305
青が50 + 255 = 305
になっているからです。

R255G100の条件でBの値をいろいろ変えてみる。

RGB(255, 100, 20) → RGB(20, 174.99, 255)
RGB(255, 100, 71) → RGB(71, 225.99, 255)
RGB(255, 100, 121) → RGB(100.01, 255, 234.01)
RGB(255, 100, 200) → RGB(100, 255, 155.01)

上の4例では、
補色前と後のRの値を足すと
275、326、355、355になります。
GとBについても同様です。
この辺りからわかりそうです。

さて、どんな計算で補色にできるのかというと、
図を描いたら分かりました。
RGB(255, 100, 20) → RGB(20, 174.99, 255)の場合

RGB(200, 150, 100) → RGB(100, 150, 200)の場合

つまり、
まず、任意の色のRGB3つ値の中で最大値と最小値を求める。
最大値をMAX、最小値をMINとすると、

補色R = MAX - R + MIN
補色G = MAX - G + MIN
補色B = MAX - B + MIN

で補色が求められる。

Sub macro100227a()
'任意の色とその補色
    Sheets.Add
    Dim i, r0, g0, b0, r1, g1, b1 As Integer
    Dim MaxValue, MinValue As Integer
    '任意の色のRGB
    r0 = 205
    g0 = 87
    b0 = 168
    'WorksheetFunctionを使うためにセルに入れる
    Cells(1, 1) = r0
    Cells(2, 1) = g0
    Cells(3, 1) = b0
    'WorksheetFuntionの範囲指定はRangeしかできない。
    '直接変数を入れることができない。
    MaxValue = Application.WorksheetFunction.Max(Range("A1:A3"))
    MinValue = Application.WorksheetFunction.Min(Range("A1:A3"))
    Debug.Print "Max = " & MaxValue & ", Min = " & MinValue
    '補色のRGB
    r1 = MaxValue - r0 + MinValue
    g1 = MaxValue - g0 + MinValue
    b1 = MaxValue - b0 + MinValue
    Debug.Print r1 & ", " & g1 & ", " & b1
    '描画
    For i = 0 To 30
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, 8 * i + 4, 10, 4, 200).Select
        Selection.ShapeRange.Fill.ForeColor.RGB = RGB(r0, g0, b0)
        Selection.ShapeRange.Line.Visible = msoFalse
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, 8 * i + 8, 10, 4, 200).Select
        Selection.ShapeRange.Fill.ForeColor.RGB = RGB(r1, g1, b1)
        Selection.ShapeRange.Line.Visible = msoFalse
    Next i
End Sub

実行後、
左端の長い四角の色が任意の色でその隣が補色。
以下、交互につづく

ちなみに「反転」だとこうなります。

なんで縞々にしたかというと
補色同士は加法混色でグレイに見えるようになるからです。
上の画像を少し離れたところから見てみてください。

次に、任意の色とその補色のグラデーションに
カラーパレットを変更します。

Sub macro100227b()
'カラーパレットを変更
'任意の色とその補色までの
'グラデーションカラーパレット
    Sheets.Add
    Dim i, r0, g0, b0, r1, g1, b1 As Integer
    Dim r, g, b As Integer
    Dim MaxValue, MinValue As Integer
    '任意の色のRGB
    r0 = 205
    g0 = 87
    b0 = 168
    'WorksheetFunctionを使うためにセルに入れる
    Cells(1, 1) = r0
    Cells(2, 1) = g0
    Cells(3, 1) = b0
    'WorksheetFuntionの範囲指定はRangeしかできない。
    '直接変数を入れることができない。
    MaxValue = Application.WorksheetFunction.Max(Range("A1:A3"))
    MinValue = Application.WorksheetFunction.Min(Range("A1:A3"))
    Debug.Print "Max = " & MaxValue & ", Min = " & MinValue
    '補色のRGB
    r1 = MaxValue - r0 + MinValue
    g1 = MaxValue - g0 + MinValue
    b1 = MaxValue - b0 + MinValue
    Debug.Print r1 & ", " & g1 & ", " & b1
   
    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

実行後の任意の色とその補色のグラデーションカラーパレットです。

「補色」の求め方から考えると
「補色」は明度を調節して「反転」する
みたいなことのようですね。

色を反転する

パソコンソフトのイラストレーターには
「反転」という機能が付いています。

上の画像の色を「反転」させるとこうなります。

もう２つほど例を挙げます。

左が反転前、右が反転後です。

これらを見てみると
反転前と後のRGBをそれぞれ足したものは
255になっています。

つまり、色を「反転」するとはどういう機能かというと、
RGB表記で

R = 34
G = 230
B = 76

という色を、

R = 255 - 34 = 221
G = 255 - 230 = 25
B = 255 - 76 = 179

という色にすることです。
RGBそれぞれの値の最大値255から
任意の色のRGBをそれぞれ引いたものが
反転した色ということになります。

Sub macro100225a()
'色を反転する
    Sheets.Add
    Dim i, r, g, b As Integer
    r = 93
    g = 200
    b = 202
    For i = 0 To 30
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, 8 * i + 4, 10, 4, 200).Select
        Selection.ShapeRange.Fill.ForeColor.RGB = RGB(r, g, b)
        Selection.ShapeRange.Line.Visible = msoFalse
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, 8 * i + 8, 10, 4, 200).Select
        Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255 - r, 255 - g, 255 - b)
        Selection.ShapeRange.Line.Visible = msoFalse
    Next i
End Sub

実行後

次に、任意の色とその反転した色のグラデーションに
カラーパレットを変更します。

Sub macro100225b()
'カラーパレットを変更
'任意の色からその反転した白までの
'グラデーションカラーパレット

    '任意の色の設定
    Dim r0, g0, b0, r1, g1, b1 As Integer
    r0 = 213
    g0 = 34
    b0 = 65
    '反転した色
    r1 = 255 - r0
    g1 = 255 - g0
    b1 = 255 - b0
   
    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

実行後の任意の色とその反転した色のカラーパレットです。

本当は、「補色」のほうをやりたかったのですが、
「反転」の方が簡単だったので
こっちにしちゃいました。

RGB関数を使ってセルの塗りつぶしの色を指定したとき実際に表示される色

記事「Excelで表 示できる色はいったい何色？」の中でとりあえず、
個人的にExcelで表示できる色は46色ってことにしましたが
（上記記事内プロシージャ「Macro100107c」を実行すると
46色だったり、52色だったりしますが…）
どうも、セルの塗りつぶしに使える色の数は
それに近いようです。

このことに関して
マイクロソフトサポートオンライン内で次の頁がありました。
「XL2000: RGB 関数が予期しない色に マップします。」

この頁で書かれているのはShapeRangeオブジェクトのことですが、
….Interior.Color = RGB(x,y,z)
の流れからすると、

Cell(i, j).Interior.Color = RGB(x,y,z)

でも同じことが起きそうです。

それで何が起きるかというと
Colorプロパティは、RGBの３つの引数を受け取ると
最も近いColor Indexにマップするらしいです。

マップってどのような日本語にすればいいかわからないけど
要するに、RGB関数で色を指定しても
その時のカラーパレットの中で一番近い色にされてしまうようです。

ということは、
セルの塗りつぶしは
RGB関数で色を指定するのはあまり意味がなく、
ColorIndexで指定した方がいいのかなと思います。

ここでまたExcelのセルの塗りつぶしに使える色の数について考えます。

RGB関数でどんな値を指定しても
必ずカラーパレットの中の近い色になってしまうなら
結局、カラーパレットの色の数の56色が
Excelのセルの塗りつぶしに使える色の数になります。

実は、「Excelで表示できる色」から
「Excelのセルの塗りつぶしに使える色」に表現を変えました。

というのは、この頁にShapeRangeオブジェクトで、
255x255x255色使える色の指定の仕方が書いてあったからです。

以下のコードでColorIndexにマップされた色と
マップされてない色を見てみます。

Sub macro100224a()
'ColorIndexにマップされた色とされない色
'セルA2の塗りつぶしの色がマップされた色
'四角の色がマップされていない色
'Stopがあるので、「F5」キーで適当に実行
    Dim r, g, b As Integer
    Sheets.Add
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 3, 30, 50, 50) _
        .Name = "Color1"
    Cells(1, 1).ColumnWidth = 14
    For r = 0 To 255
        For g = 0 To 255
            For b = 0 To 255
                Cells(1, 1) = "RGB(" & r & ", " & g & ", " & b & ") ＝"
                Cells(1, 2) = RGB(r, g, b)
                'セルの塗りつぶしの色設定
                Cells(2, 1).Interior.Color = RGB(r, g, b)
                Cells(2, 2) = Cells(2, 1).Interior.Color
                'シェイプの色設定
                ActiveSheet.Shapes("Color1").Select
                Selection.ShapeRange.Fill.ForeColor.RGB = RGB(r, g, b)
                Cells(3, 2) = Selection.ShapeRange.Fill.ForeColor.RGB
                Calculate
                Stop
            Next b
        Next g
    Next r
End Sub

実行中の様子

セルA1が今のRGBの状態、
その横のセルＢ１がそのRGB関数を長整数型で表したもの。

セルA2の塗りつぶしをRGB関数で設定して
マップされた色を見る。
その横セルB2がそのセルから取得した色の長整数型。

セルB3が四角のシェイプから取得した色の長整数型。

種々のカラーパレット 5

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

「種々のカラーパレット 4」では、
色相のグラデーションを
均等に淡くしたり暗くしたカラーパレットに変更する
プロシージャを書きました。
次は、Red、Green、Blueについて個別に
淡くしたり暗くしたりできるようにします。

上記記事中のコードでは、
v_maxをｒ、ｇ、ｂそれぞれに使いました。
ここをｒ、ｇ、ｂそれぞれで別の値を使うために
rv_max、ｇv_max、bv_maxという3つの変数にします。

もちろん、tornのところも
rtorn、gtorn、btornの3つの変数にします。

Sub macro100223a()
'カラーパレットを変更
'色相のグラデーション
'偏向トーン変化あり(rtorn, gtorn, btorn > 0)

    Dim i, r, g, b As Integer
    Dim rtorn, gtorn, btorn As Integer
    Dim rv_max, gv_max, bv_max 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)
    'トーンの設定
    rtorn = 180
    gtorn = 0
    btorn = 0
    rv_max = 255 - rtorn
    gv_max = 255 - gtorn
    bv_max = 255 - btorn
        For i = 0 To 6
            r = rv_max + rtorn
            g = Int(gv_max * i / 6) + gtorn
            b = 0 + btorn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 7 To 13
            r = Int(rv_max - (rv_max * (i - 6) / 7)) + rtorn
            g = gv_max + gtorn
            b = 0 + btorn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 14 To 20
            r = 0 + rtorn
            g = gv_max + gtorn
            b = Int(bv_max * (i - 13) / 7) + btorn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 21 To 27
            r = 0 + rtorn
            g = Int(gv_max - (gv_max * (i - 20) / 7)) + gtorn
            b = bv_max + btorn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 28 To 34
            r = Int(rv_max * (i - 27) / 7) + rtorn
            g = 0 + gtorn
            b = bv_max + btorn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 35 To 39
            r = rv_max + rtorn
            g = 0 + gtorn
            b = Int(bv_max - (bv_max * (i - 33) / 7)) + btorn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i

End Sub

変更後の＋偏向色相のグラデーションカラーパレットです。
比較用に、右に偏向なしの色相のパレットを載せます。

rtorn = 180ということは、
RGB関数の引数Redが最低でも180はあるということです。

偏向のない色相では、
緑からシアン、青への変化のときは引数Redは0なので
rtorn = 180にすると、引数Redは180になり、
このあたりのグラデーションが特に目立って変化します。

緑からシアン、青への変化はRGB関数で表します。
上が偏向なし、下が偏向あり。

RGB(0, 255, 0) → RGB(0, 255, 255) → RGB(0, 0, 255)
RGB(180, 255, 0) → RGB(180, 255, 255) → RGB(180, 0, 255)

次は、
-偏向色相のグラデーションカラーパレットにするコードです。

Sub macro100223b()
'カラーパレットを変更
'色相のグラデーション
'偏向トーン変化あり(rtorn, gtorn, btorn < 0)

    Dim i, r, g, b As Integer
    Dim rtorn, gtorn, btorn As Integer
    Dim rv_max, gv_max, bv_max 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)
    'トーンの設定
    rtorn = 0
    gtorn = -90
    btorn = 0
    rv_max = 255 + rtorn
    gv_max = 255 + gtorn
    bv_max = 255 + btorn
        For i = 0 To 6
            r = rv_max
            g = Int(gv_max * 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(rv_max - (rv_max * (i - 6) / 7))
            g = gv_max
            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 = gv_max
            b = Int(bv_max * (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(gv_max - (gv_max * (i - 20) / 7))
            b = bv_max
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 28 To 34
            r = Int(rv_max * (i - 27) / 7)
            g = 0
            b = bv_max
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 35 To 39
            r = rv_max
            g = 0
            b = Int(bv_max - (bv_max * (i - 33) / 7))
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i

End Sub

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

gtorn = -90ということは、
RGB関数の引数Greenが最高でも255 - 90 = 165ということです。
上の画像を見てみると、
引数Greenが関わるイエロー、緑、シアンと変化していくところが
暗い色になっています。

種々のカラーパレット 4

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

「種々のカラーパレット 3」の最後の方で、
色相のグラデーションを
淡くしたり暗くしたカラーパレットに変更する
プロシージャを書いたのですが、
やはり、ただ単に「+ torn」を加えただけでは
同じような色が続いてしまったりしてました。

これを改良します。
淡くしたり暗くするときのRGB関数の引数を
棒グラフで表してみる。

つまり、淡くするときは、
255 - tornを何等分かして増減させたものに
tornを加えれば色相全体を淡くできます。

逆に、暗くするには
255 + torn (torn < 0)が各引数の最大値なので
この255 + tornを何等分化して増減させれば
色相全体が暗くなります。

以上のようにtornがプラスかマイナスかで計算方法が違いますので
tornがプラスのときとマイナスのときを２つのプロシージャに分けました。

まずは、
改良版・淡い色相のグラデーションカラーパレットにするコードです。

Sub macro100222a()
'カラーパレットを変更
'色相のグラデーション
'トーン変化あり,改良版(torn > 0)

    Dim i, r, g, b, torn, v_max 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)
    'トーンの設定(0 < torn < 255)
    torn = 200
    v_max = 255 - torn
        For i = 0 To 6
            r = v_max + torn
            g = Int(v_max * i / 6) + torn
            b = 0 + torn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 7 To 13
            r = Int(v_max - (v_max * (i - 6) / 7)) + torn
            g = v_max + torn
            b = 0 + torn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 14 To 20
            r = 0 + torn
            g = v_max + torn
            b = Int(v_max * (i - 13) / 7) + torn
            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(v_max - (v_max * (i - 20) / 7)) + torn
            b = v_max + torn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 28 To 34
            r = Int(v_max * (i - 27) / 7) + torn
            g = 0 + torn
            b = v_max + torn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 35 To 39
            r = v_max + torn
            g = 0 + torn
            b = Int(v_max - (v_max * (i - 33) / 7)) + torn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i

End Sub

変更後の改良版・淡い色相のグラデーションカラーパレットです。
改良前も比較で載せます。

次は、
改良版・暗い色相のグラデーションカラーパレットにするコードです。

Sub macro100222b()
'カラーパレットを変更
'色相のグラデーション
'トーン変化あり,改良版(torn < 0)

    Dim i, r, g, b, torn, v_max 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 < 0))
    torn = -100
    v_max = 255 + torn
        For i = 0 To 6
            r = v_max
            g = Int(v_max * 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(v_max - (v_max * (i - 6) / 7))
            g = v_max
            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 = v_max
            b = Int(v_max * (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(v_max - (v_max * (i - 20) / 7))
            b = v_max
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 28 To 34
            r = Int(v_max * (i - 27) / 7)
            g = 0
            b = v_max
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 35 To 39
            r = v_max
            g = 0
            b = Int(v_max - (v_max * (i - 33) / 7))
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i

End Sub

変更後の改良版・暗い色相のグラデーションカラーパレットです。

多少の違いですが、数値を見ればよく分かります。
数値はイミディエイトウィンドウに表示するようになってます。

種々のカラーパレット 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

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

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

種々のカラーパレット 2

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

まずは、シアン・マゼンダ・イエロー同士のグラデーションです。

シアンからイエローのカラーパレットの場合、
シアンとイエローをそれぞれRGB関数で表すと、

RGB(0, 255, 255)
RGB(255, 255, 0)

引数Greenのところは両方とも255なので変化しません。
あとは、引数Redが0から255まで、
引数Blueが255から0まで変化させると
シアンからイエローのグラデーションができます。

Sub macro100220a()
'カラーパレットを変更
'シアンからイエロー

    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 = Int(255 * i / 39)
            g = 255
            b = 255 - r
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
        Next i
       
End Sub

変更後のシアンからイエローカラーパレットです。

Sub macro100220b()
'カラーパレットを変更
'マゼンダからシアン

    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
            g = Int(255 * i / 39)
            b = 255
            r = 255 - g
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
        Next i
       
End Sub

変更後のマゼンダからシアンカラーパレットです。

Sub macro100220c()
'カラーパレットを変更
'イエローからマゼンダ

    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
            b = Int(255 * i / 39)
            r = 255
            g = 255 - b
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
        Next i
       
End Sub

変更後のイエローからマゼンダカラーパレットです。

次は、単色濃淡グラデーションです。

赤を単色として使います。
黒から赤のグラデーションについて説明します。
黒と赤はRGB関数で表すとそれぞれ

RGB(0, 0, 0)
RGB(255, 0, 0)

つまり、引数Redを0から255まで変化させると
黒から赤のグラデーションになります。

Sub macro100220d()
'カラーパレットを変更
'単色濃淡グラデーション
'黒から赤

    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 = Int(255 * i / 39)
            g = 0
            b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
        Next i
       
End Sub

変更後の黒から赤のカラーパレットです。

今度は、白から赤のグラデーションです。
白と赤をRGB関数で表すとそれぞれ

RGB(255, 255, 255)
RGB(255, 0, 0)

引数Redは常に255で変化しません。
引数GreenとBlueは255から0まで変化させます。

Sub macro100220e()
'カラーパレットを変更
'単色濃淡グラデーション
'白から赤

    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 = 255
            g = 255 - Int(255 * i / 39)
            b = 255 - Int(255 * i / 39)
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
        Next i
       
End Sub

変更後の白から赤のカラーパレットです。

いままでは、単色に赤を使っていました。
次は、単色を任意のRed、Green、Blueで設定します。
変数r0、g0、b0で任意の色のRGB関数の引数を設定します。

任意の色から白に変化するグラデーションについて説明します。

任意の色と白をRGB関数でそれぞれ表すと

RGB(r0, g0, b0)
RGB(255, 255, 255)

になります。
引数Red、Green、Blueをそれぞれ
r0から255、g0から255、b0から255まで変化させれば
任意の色から白のグラデーションになります。

任意の色から黒のグラデーションの方は
任意の色と黒はRGB関数で表すと

RGB(r0, g0, b0)
RGB(0, 0, 0)

なので、r0から0、g0から0、b0から0まで変化させれば
任意の色と黒のグラデーションになります。

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

    '任意の色の設定
    Dim r0, g0, b0 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 = 39 To 0 Step -1
            r = r0 + Int((255 - r0) * i / 39)
            g = g0 + Int((255 - g0) * i / 39)
            b = b0 + Int((255 - b0) * i / 39)
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
        Next i
       
End Sub

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

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

    '任意の色の設定
    Dim r0, g0, b0 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 39
            r = r0 - Int(r0 * i / 39)
            g = g0 - Int(g0 * i / 39)
            b = b0 - Int(b0 * i / 39)
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
        Next i
       
End Sub

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

種々のカラーパレット

記事「カラーパレ ットを変更する」において
カラーパレットを変更する方法について書きました。

今回は、
いろいろな色のカラーパレットを作りたいと思います。
上記記事の中の
冷静と情熱カラーパレットに変更するコードの
RGB関数の引数Red、Green、Blueの値のところを変更して、
違う色のカラーパレットにします。

まずは、白から黒へ徐々に変化していくカラーパレットにします。
無彩色はRedとGreenとBlueの値が同じです。
例えば、
Red = Green = Blue = 255なら、白で
Red = Green = Blue = 0は、黒
Red = Green = Blue = 123は、なんらかの濃さのグレー
になります。

Sub macro100219a()
'カラーパレットを変更
'グレースケール

    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 = Int(255 * i / 39)
            g = r
            b = r
            Debug.Print r
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
        Next i

End Sub

変更後のグレースケールカラーパレットです。

次は、
緑から赤へ、青から緑へ変化するカラーパレット。
青から赤へ変化するカラーパレットは、
冷静と情熱カラーパレットに変更するコードでできます。
原理はそのコードと同じです。

Sub macro100219b()
'カラーパレットを変更
'緑から赤へ

    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 = Int(255 * i / 39)
            g = 255 - r
            b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
        Next i

End Sub

変更後の緑から赤のカラーパレットです。

Sub macro100219c()
'カラーパレットを変更
'青から緑

    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 = 0
            g = Int(255 * i / 39)
            b = 255 - g
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
        Next i
       
End Sub

変更後の青から緑のカラーパレットです。

加法混色の三原色と減法混色の三原色の関係は
次のようになっています。

赤 + 緑 = シアン
緑 + 青 = イエロー
青 + 赤 = マゼンダ

RGB関数では、

RGB(255, 255, 0) = イエロー
RGB(0, 255, 255) = シアン
RGB(255, 0, 255) = マゼンダ

になります。

次は、シアン・マゼンダ・イエローを使っていきます。

青からイエローのカラーパレットの場合を説明しますと、
青はRGB（0, 0, 255)、
イエローはRGB(255, 255, 0)なので、
RGB（0, 0, 255)からRGB(255, 255, 0)に徐々に変化させます。
RGB関数の引数RedとGreenを同じ値にする以外は
赤から青のカラーパレットに変更するときと
あまりかわりません。

Sub macro100219d()
'カラーパレットを変更
'青からイエロー

    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 = Int(255 * i / 39)
            g = r
            b = 255 - r
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
        Next i
       
End Sub

変更後の青からイエローのカラーパレットです。

Sub macro100219e()
'カラーパレットを変更
'緑からマゼンダ

    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 = Int(255 * i / 39)
            g = 255 - r
            b = r
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
        Next i
       
End Sub

変更後の緑からマゼンダのカラーパレットです。

Sub macro100219f()
'カラーパレットを変更
'赤からシアン

    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
            g = Int(255 * i / 39)
            b = g
            r = 255 - g
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
        Next i
       
End Sub

変更後の赤からシアンのカラーパレットです。

カラーパレットを変更する

手動でカラーパレットを変更するには
メニュー[ツール] - [オプション]を選びます。
すると、このようなダイアログが表示されます。

このダイアログの[色]タブのところの[変更]ボタンで
カラーパレットを変更できます。
[変更]ボタンの下の[リセット]ボタンで
デフォルトのカラーパレットに戻すことができます。

VBAでカラーパレットの色を変更するには
Colors プロパティを使います。

ActiveWorkbook.Colors(1) = RGB(0, 0, 0)

のように使います。
上の例は、アクティブなワークブックのカラーパレットの
カラーインデックス1を、RGB(0, 0, 0)に設定しています。

セルの塗りつぶしをVBAで実行するときに

Cells(1, 1).Interior.ColorIndex = 1

のようにカラーインデックスで指定できます。

このカラーインデックスが
Colorsプロパティで設定する番号と同じになっています。
ですから、

ActiveWorkbook.Colors(1) = RGB(0, 0, 0)
Cells(1,1).Interior.ColorIndex = 1

と実行すると
セルA1（=Cells(1,1)）の塗りつぶしがRGB(0, 0, 0)で設定されます。

ActiveWorkbookのところは

Workbooks("Book1.xls").Colors(1) = RGB(0, 0, 0)

のようにしても使えます。

カラーパレットの色は56色あるので

ActiveWorkbook.Colors(1) = RGB(0, 0, 0)
ActiveWorkbook.Colors(2) = RGB(0, 0, 128)
ActiveWorkbook.Colors(3) = RGB(0, 102, 0)
…
ActiveWorkbook.Colors(56) = RGB(255, 255, 255)

のようにカッコ内の数字を1～56まで替えて
それぞれの色を設定できます。

最初の画像から分かるように
カラーパレットは、横 8 ｘ 縦 7 = 56色なのですが、
カラーインデックスは
上から順に1列目の左から1, 2, 3, 4, 5, 6, 7, 8
2列目の左から9, 10, 11, 12, 13, 14, 15, 16…
といった順番にはなっていません。

調べてみたところ
このような順番になっていました。

VBAでのみ色を使う場合は
カラーパレットでの並び順は
大して重要ではないかもしれませんが、
手動で色をつけるときは
並び順は分かりやすい方がいいと思います。

実際にパレットを変更してみます。

青から赤へ
定量的に変化していくパレットに変更します。
名付けて「冷静と情熱カラーパレット」～
なんて
いつかの映画のタイトルを借用して
ドーデモいいこと言ってみたりしました。

数値の大小を表すのに
色の濃度や色相の変化を使うことがあります。
例えば、テレビでよく見るサーモグラフィーなどです。
温度が高い方が赤系の色
低い方が青系の色が使われます。
こういったことに使えそうなパレットです。

コードはこちら

Sub macro100218a()
'カラーパレットを変更
'パレットの上から5段目までを変更

    Dim i, r, b As Integer
    Dim MyIndex As Variant
    'ColorIndexが順番になっていないので
    '配列を作ってそこに1段目左から5段目右までの
    'ColorIndexを入れる。
    'その配列を使うことで0から39まで順番に色を設定していける
    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 + b = 255の関係
            '255を39分割
            r = Int(255 * i / 39)
            b = 255 - r
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, 0, b)
        Next i

End Sub

変更後のパレットです。

カラーパレットを変更すると
同じワークブック内で変更前に使った色が
変化してしまうのでご注意を。

規定のカラーパレットに戻す方法はこちらです。

Sub macro100218b()
'カラーパレットを規定に戻す

    ActiveWorkbook.ResetColors
   
End Sub

セル内で改行、マクロ自動記録では…

Excelでやっているいろいろな手動での操作を
VBAで実行したいとき、
マクロの自動記録をして調べたりします。

他ごとでマクロ自動記録をしていたら
コメント内で改行したとき
改行がChr(10)で記録されていました。

ライン フィード文字とキャリッジ リターンの違いは
未だによく分からないけど
マクロ自動記録で改行がChr(10)になっているなら
改行はChr(10)でいいみたいです。

以下セルA1にこのように入力したときの
マクロ自動記録です。

Sub macro100217a()
'セル内で改行をマクロ自動記録したもの

    Range("A1").Select
    ActiveCell.FormulaR1C1 = "改行前" & Chr(10) & "改行後"
    With ActiveCell.Characters(start:=1, Length:=7).Font
        .Name = "ＭＳ Ｐゴシック"
        .FontStyle = "標準"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    ActiveCell.Characters(1, 2).PhoneticCharacters = "カイギョウ"
    ActiveCell.Characters(3, 1).PhoneticCharacters = "マエ"
    ActiveCell.Characters(5, 2).PhoneticCharacters = "カイギョウ"
    ActiveCell.Characters(7, 1).PhoneticCharacters = "ゴ"
    Range("A2").Select
End Sub

やはり、マクロ自動記録。

セルA1にちょっと入力しただけで
この長さ。

削除とクリア

手動で「削除」や「クリア」をするときは
メニューの[編集]を選んで、
それぞれ[削除]や[クリア]を選びます。

「クリア」は以下4つの方法があります。

すべて
書式
数値と値
コメント

セルの値を消すとき
よくキーボードのDeleteキーを使います。

「数値と値」のところの横に「Del」と書いてあるので
キーボードのDeleteキーを押してクリアした場合と
[編集] - [クリア] - [数値と値]でクリアした場合は
同じ操作になります。

「削除」と「クリア」は違います。

「削除」はセルそのものを無くしてしまいます。
ですからなくなったセルの分だけ上または左にシフトします。
例えば、セルA1選択して「削除」した場合は
このようなダイアログが出ます。

ここで[上方向にシフト]を選ぶと
[削除]前のセルA2がA1に、A3がA2にのように
上へずれます。
[左方向にシフト]を選ぶと左にずれます。

行や列を選択して[削除]した場合は
自動的にそれぞれ上方向、左方向にずれます。

VBAで[削除]するには、Delete メソッドを使います。
使用例を挙げます。

Sub macro100216a()
'Delete使用例
    '上方向へシフト
    Cells(1, 1).Delete Shift:=xlShiftUp
   
    '左方向へシフト
    Cells(1, 1).Delete Shift:=xlShiftToLeft
   
    'Shift指定なしの場合は上方向にシフトする
    Cells(1, 1).Delete
   
    'Rangeで範囲指定する
    Range("A1:C3").Delete Shift:=xlShiftUp
   
    '行を削除、シフトは指定しなくてもいい
    '1行目を削除する
    Rows(1).Delete
   
    '列を削除、シフトは指定しなくてもいい
    'A列を削除する
    Columns("A").Delete
   
End Sub

「クリア」は「削除」と違って
セルそのものは無くならずに
セルの内容や塗りつぶし、文字の色、枠などを消します。

Excelを使い始めのころは
枠だけ消したいのに消す方法がわからなくて
苦労したこともありました。

VBAで[クリア]するには、Clear メソッドを使います。
使用例を挙げます。

Sub macro100226b()
'Clear使用例
    '[クリア] - [すべて]
    Range("B2").Clear
   
    '[クリア] - [書式]
    Range("B3").ClearFormats
   
    '[クリア] - [内容]
    Range("B4").ClearContents
   
    '[クリア] - [コメント]
    Range("B5").ClearComments
End Sub

下の画像はこのコードを実行した結果です。

実行前はRange("A2:B5")はすべて同じです。
内容は「クリア使用例」、
書式は、枠・太字・文字の色・塗りつぶしを適用してあり、
コメントが挿入してあります。

B2:B5にそれぞれのClearを実行しました。

インターネットのホームページをコピーして
Excelに「Ctrl + v」で直接ペーストしたとき、
リンクや色、スタイルなんかも一緒にペーストされます。

このリンクや色、スタイルなんかは
[クリア] - [書式]、
VBAならClearFormatsで
消すことができます。

関連：
ホームページをコピーしたときは
[編集] - [形式を選択して貼り付け]で
「テキスト」を選べば、
リンクや色、スタイルなんかはペーストされず
文字だけペーストできます。

セルの書式設定で日本語の曜日を表示させる

セルの書式設定で表示形式を変更するには
変更したい範囲を選んで
メニューの[書式]-[セル]で
セルの書式設定のダイアログを表示させます。

次に、「表示形式」タブを選択して
任意の形式を選ぶか、
ユーザー定義を選び自分で入力します。

右クリックしてメニュを表示させて
[セルの書式設定]を選択しても
このダイアログを表示できます。

ユーザー定義で日付や時刻に使う記号は
Excelヘルプの「日付や時刻の書式記号について」の頁が
詳しいのですが
なぜか日本語の曜日に関する記号が載っていません。

日本語で曜日を表す記号は、aです。

aaa	月、火、水、木、金、土、日
aaaa	月曜日、火曜日、水曜日、…

以上のように使います。
例えば、「2010年1月1日（金）」と表したいときは

yyyy"年"m"月"d"日("aaa")"

です。

忘れたら、
適当にアルファベットをaから使っていけば
すぐ見つかります。

関連して「元号」について…

元号の記号はgです。
おそらくgengouの頭文字のgだと思います。

g	H
gg	平
ggg	平成

元号と一緒に使う「年」の記号はeです。
例えば、平成22年なら

e

22

あわせて使うと

ge	H22
gge	平22
ggge	平成22
ggge"年度"	平成22年度

テキトーにアルファベットを入力してみたら
こんなのもありました。

r	22
rr	平成22

rでも元号で表示できるみたいです。

日時と時間

ｘ月ｘ日ｘｘ時ｘｘ分から
o月o日oo時oo分までの時間の「量」を計算したい時について

下の画像のように
セルA3を
=A1-A2
という数式にして間の時間を出そうとすると
こんな風になります。

「4時間」という時間を出したいのに
0日なんてよくわからない日時になってしまっています。

上の画像ではA列の表示形式は「日時」です。
B列にA列の値を表示形式「標準」にしたものを入れるとこうなります。

確かにB2-B3 = B4になっています。

既定では、Windows 版 Excel では、
1900 年日付システムを使っていて

1900/1/1

は表示形式「標準」では、1になります。

1900/1/2は、2
1900/1/3は、3
1900/1/4は、4

以上のように
1日という時間の「量」は1です。
よって

1日 = 1
24時間 = 1
1時間 = 1/24
60分 = 1/24
1分 = 1/24/60
1秒 = 1/24/60/60

で表されます。
二番目の画像のセルB4の単位は「日」で
0.166666667日ということになります。
0.166666667日は

0.166666667 * 24　時間
0.166666667 * 24 * 60 分間
0.166666667 * 24 * 60 * 60 秒間

なので
ｘ月ｘ日ｘｘ時ｘｘ分から
o月o日oo時oo分までの時間の「量」を計算したい時は
時間単位で表したいなら
2つの日時の差に「* 24」をします。
分単位だった「* 24 * 60」、
秒単位だったら「* 24 * 60 * 60」をします。

下の画像は
C列にそれぞれの単位に計算したものを追加。

続いて、
切りがよくない数字のとき
例えば次のような場合

切りがよい数字は
「分」だけ「秒」だけで表しても分かりやすいです。
しかし、上のような数字の場合
切捨てや四捨五入をしないなら、
x日ｘｘ時間ｘｘ分xx秒のように表した方が
分かりやすいです。

例えば
セルA2からセルA3までの期間を出したいときは
次の数式を使います。（A2>A3）

=DATEDIF(A3,A2,"D") & "日" & HOUR(A2-A3) & "時間" & MINUTE(A2-A3) & "分" & SECOND(A2-A3) & "秒"

次の画像のセルC4にこの数式が入力してあります。

DATEDIF(開始日,終了日,単位)は、
開始日から終了日までの時間を返します。
日単位なら、単位のところは"D"。

なぜ、日数だけDAY関数ではないかというと
DAY関数は1 ～ 31までしか返さないからです。

例えば
(2010/3/3)から(2010/1/1)を引いたものを
DAY関数に入れると1になります。
この期間の日数は、31 + 27 + 3 = 61日です。

どうも、日付・時刻の関数を使っていると、
日時を表す「時間」と
時の長さを表す「時間」が
「時間」という同一の言葉を介して
頭の中でその区別が曖昧になるように感じます。
（私だけでしょうか…）

各ワークシート関数はExcelのヘルプのそれぞれの頁、
日付については「日付と時刻の処理について」の頁を参照。

Excelは見えないところでギザ休む

記事「マルチコアと VBA 」において
タスクマネージャの「パフォーマンス」のところ
「CPU使用率の履歴」について書きました。

その記事で
シングルコアのパソコンの場合
プロシージャを実行すると使用率が100%になると
書きました。

実は…
Excelは見えないところでギザ休むことがあるのです。

しょこたん風にギザなどと書きましたが
ギザ＝たいへん
的な意味ではありません。
その理由はジョジョに明らかになります。

長時間かかるプロシージャを実行する時
そのプロシージャに掛かる時間を一部だけ測定して
ある程度どのくらいの時間が掛かるか予想します。

そして、そのプロシージャを実行してから
パソコンの前を離れます。

もう終わっただろうと思って
パソコンを見てみるとまだ終わっていない、
なんてことが何回かありました。

調べてみると測定した時よりも
3倍くらい時間が掛かっていました。

最初は原因がわからず
もやもやしましたが
前述の「CPU使用率の履歴」を見ていたら
原因がわかりました。

実はExcelはExcelのウィンドウが最前面に出ていないと
速度が遅くなるようです。

以下に
ウィンドウが最前面の場合と
最前面以外の場合の「CPU使用率の履歴」を載せます。
矢印のところから見てください。

こちらがウィンドウが最前面の場合の「CPU使用率の履歴」

こちらが最前面以外の場合の「CPU使用率の履歴」

ご覧の通り
上の画像が矢印の所から常に100%であるのに対して
下の画像は矢印の所からギザギザになっています。
つ・ま・り…

Excelは見えないところでギザ休んでいるのです（笑）

いやいや最前面に出ていない時は
出しゃばらない、
空気を読める
ギザカワユスなエクセルちゃんです。

とにかく、
プロシージャの実行速度が予測よりも遅い時は
タスクマネージャを見てみましょう！
Excelのウィンドウを最前面に出してみましょう！
ということです。

タスクマネージャと速度つながりで
話は続きます。

タスクマネージャの「プロセス」タブで枠内の1つを選んで
右クリックすると以下のメニューが出てきます。

この中で「優先度の設定」を選ぶと
このような選択肢が出てきます。

ウィンドウズをカスタマイズするような主旨の本に
プログラムの速度を速くしたいときは
これを「通常以上」とかにする。
と書いてあるのを見たことがあったので、
警告を無視して
「通常以上」「高」「リアルタイム」の全てで
速度を測ってみましたが
管理人ローカル環境では全く効果なしでした。

タスクマネージャについてですが
Win98では最前面から後ろに行ってくれたのですが
WinXPではなぜか他のウィンドウをアクティブにしても
一番前にいます。

かなり邪魔ですが
Excelがギザ休んでないかチェックするために
必要のなのでしょうがないですね～
エクセルちゃんを見習って
空気読んでほしいです。

ピクセル単位でセルの高さと幅を指定する

ピクセル単位でセルの高さと幅を指定する

記事「セルの縦と 横の比 」
記事「セルの高さ と幅の設定 」
でセルの高さと幅を設定しようとしてきました。

思ったとおりに高さと幅が設定できないので
またまた違う方法でアプローチしたいと思います。

msdnの該当ページによると
どうも最終的にセルの高さと幅を決める単位は
ピクセルのようなので
ピクセル単位でセルの高さと幅を指定したいと思います。

RowHeigthとColumnWidthは
それぞれポイント単位と文字単位で指定するので
直接ピクセル単位で指定はできません。

かといって
ピクセルをポイントに変換する関数などは
見当たらない。

そこで、もう何回も使っているあの比率を
くどくどと使っちゃいます。

幅　　　　11.8ポイント：100ピクセル
高さ　　　75ポイント：100ピクセル

つまり

幅　　　　0.118ポイント：1ピクセル
高さ　　　0.75ポイント：1ピクセル

この比率を使います。

ようするに単なる掛け算で
例えば、
幅を30ピクセルにしたかったら
まず

30 * 0.118 = 3.54　ポイント

のようにピクセルからポイント単位に変換してから
ColumnWidthに使う。
そうするとこの様になります。

Cells.ColumnWidth = 30 * 0.118

汎用性を持たせるために
以下のコードでは
30のところを変数にして
いろいろと設定できるようにしました。

コードはこちら

Sub macro100211a()
'ピクセル単位でセルを任意の正方形にする
    Sheets.Add
   
    Dim L As Integer
    '一辺の長さ
    L = 18
    Cells.RowHeight = L * 0.75
    Cells.ColumnWidth = L * 0.118
   
End Sub

実行後のセルはこの様になりました。

上のコードでは
セル全部を正方形に変更しました。

今度は高さと幅の両方を設定できるようにします。

また、再利用性を考えて
高さと幅を設定するプロシージャを独立させて
そのプロシージャを
他のプロシージャから呼び出すことにしました。

下のコードでは macro100211b において
SetCellsHW プロシージャを呼び出して
値を渡しています。
MyHeightに高さ、MyWidthに幅を指定します。

コードはこちら
macro100211b の方を実行してください。

Sub macro100211b()
'ピクセル単位でセルの高さと幅を指定する
    Sheets.Add
   
    Call SetCellsHW(30, 50)
   
End Sub
Sub SetCellsHW(MyHeight As Integer, MyWidth As Integer)
'ピクセル単位でセルの高さと幅を指定する

    Cells.RowHeight = MyHeight * 0.75
    Cells.ColumnWidth = MyWidth * 0.118

End Sub

実行後のセル

正方形にする方のコードで
いろいろな値を試しましたが
値が小さいと正方形に見えないくらい
高さと幅に差が出るようです。

Cellsの解剖

記事「HTMLのTableをVBAで作る 4」で
ウォッチウィンドウについてチラッと書いたので
そのことについて。

まずはウォッチウィンドウの表示の仕方：
VBEのメニューで

[表示]-[ウォッチウィンドウ]

で表示できます。

使い方について：
以下のコードでウォッチウィンドウを使ってみます。

Sub macro100210a()
    Dim obj As Object
   
    Set obj = Cells(1, 1)
    Stop
   
End Sub

Cells(1, 1)を
Object型のobjに入れているだけです。
よくSetステートメントを忘れてエラーになり
理由がわからず四苦八苦するので要注意。
ちなみに
Setステートメントを忘れた時の
エラーダイアログの文面はこのようになっています。

実行時エラー '91':
オブジェクト変数または With ブロック変数が設定されていません。

プロシージャを実行する前に
まず、ウォッチ式に式を追加します。
追加したい対象を
この様にカーソルで選んで反転させる。

この状態で右クリックして
「ウォッチ式に追加する」を選択する。

そうすると下のようなダイアログが表示される。
式のテキストボックスが
ウォッチ式に追加したい通りになっていれば
そのままOKを押す。

対象のプロシージャを実行していない状態では
このようにEmptyの状態。

プロシージャを実行すると
ツリーが現れるので
Cells(1,1)についてのプロパティを見ることができる。

ウォッチウィンドウなんて名前だけど
ウォッチするだけじゃなく
値を変えることもできます。

ウォッチウィンドウの「値」の項目をダブルクリックすると
入力できるようになります。
入力後は必ずEnterを押してください。
Enterを押さないと入力前の値のまま
変更されません。

今回の例ではCells(1, 1)をObject型に入れて
中身を見たけれど、
Cellsでなくても中を見れるので
InternetExplorerを操作する時や
XMLをExcelで利用する時とかに、
中身が見れるので非常に便利。

また、

For i = 0 to 10000
…
Next i

などとあるときに
i をウォッチ式に追加して
i の値をウォッチウィンドウで変更して
途中から実行させるなんてこともできます。

HTMLのTableをVBAで作る 4

記事「HTMLのTableをVBAで作る」では
セルの「塗りつぶし」を
記事「HTMLのTableをVBAで作る 2」では
セルの「塗りつぶし」と「大きさ」をTableにしました。
記事「HTMLのTableをVBAで作る 3」では
「文字」も反映させました。

次は、セル内の文字の色と大きさも付け加えます。

セル内の文字のプロパティを使ったことがないので
Fontに関するプロパティを
ウォッチウィンドウで調べます。

こんな風になってます。
よくわからないプロパティもありますが
よく使うと思われるのが

Bold
Color
ColorIndex
Italic
Size

と、これくらいでしょうか。
個人的にわかりやすく並べかえます。

Size
Color
ColorIndex
Bold
Italic

SizeプロパティはIntegerのようなイメージだったのですが
Double型。
思った以上に
キメ細やかな設定が可能なのでしょうか？
試してみます。

ウオッチウィンドウのSizeプロパティを変更して
18.3にしてみました。
（上の画像のSizeの値のところ）
Excelのウィンドウのフォントのサイズは
18.5になってます。

いろいろ試しましたが
0.5刻みで設定が可能のようです。
18.1なら18に、
18.6なら18.5に、
18.8なら19にまるめられます。

Colorプロパティはおなじみ、長整数型。
ColorIndexも1から56までの整数はおなじみ。
BoldとItalicはTrue or FalseのBoolean型。

まず最初に…
テキトーに文字を入れ
テキトーに色をつけた
4x4のセルを用意しました。

これをTableにします。

この例で新しく使うプロパティは

Cells( i, j ).Font.Size
Cells( i, j ).Font.Color
Cells( i, j ).Font.Bold
Cells( i, j ).Font.Italic

Sizeはそのままstyle属性に使います。
Colorは今まで通り16進数に変換して使う。
BoldとItalicはそれぞれTrueの場合に、
style属性に
font-wight:bold;とfont-style:italic;を追加する。

コードはこちらです。

Sub macro100209a()
    Dim i, j As Integer
    Dim MyHTML As String
    '生成したHTMLを入れる
   
    Dim bg_HexColor, font_HexColor As String
    '長整数型を16進数に変換した文字列を入れる
    Dim TWidth, THeight As Integer
    'Tableの幅と高さを入れる
    Dim AddTWidth, MyStyle As String
    '順にwidth属性とstyle属性の文字列
   
    MyHTML = "<TABLE><TBODY>"
    For i = 1 To 4
        'i行の始まり
        '高さ設定
        THeight = Int(Cells(i, 1).RowHeight * 100 / 75)
        MyHTML = MyHTML & "<TR height=" & THeight & ">"
        For j = 1 To 4
            'i行j列について
            MyStyle = "style=" & Chr(34)
            
            '幅設定、1行目のみ
            If i = 1 Then
                TWidth = Int(Cells(i, j).ColumnWidth * 100 / 11.8)
                AddTWidth = " width=" & TWidth
            End If
            
            'Boldの判定
            If Cells(i, j).Font.Bold Then
                MyStyle = MyStyle + "font-weight:bold;"
            End If
            
            'Italicの判定
            If Cells(i, j).Font.Italic Then
                MyStyle = MyStyle + "font-style:italic;"
            End If
            'フォントサイズを追加
            MyStyle = MyStyle + "font-size:" & Cells(i, j).Font.Size & "pt;"
            '背景色を追加
            bg_HexColor = LngtoHexColor(Cells(i, j).Interior.Color)
            MyStyle = MyStyle + "background:" & bg_HexColor & ";"
            'フォントの色を追加
            font_HexColor = LngtoHexColor(Cells(i, j).Font.Color)
            MyStyle = MyStyle + "color:" & font_HexColor & ";" & Chr(34)
            MyHTML = MyHTML & "<TD " & MyStyle & AddTWidth & ">" & _
                Cells(i, j) & "</TD>"
            AddTWidth = "" 'AddTWidthをなしにする
        Next j
        MyHTML = MyHTML & "</TR>"
    Next i
    MyHTML = MyHTML & "</TBODY></TABLE>"
   
    '生成したHTMLを適当なセルに書き出す
    Cells(6, 1) = MyHTML
End Sub

下が生成されたTableのHTMLソースです。

<TABLE><TBODY><TR height=56><TD style="font-weight:bold;font-size:36pt;background:#99CC00;color:#FF0000;" width=62>G</TD><TD style="font-style:italic;font-size:18pt;background:#FFCC00;color:#808000;" width=74>B</TD><TD style="font-size:24pt;background:#FF00FF;color:#00CCFF;" width=48>5</TD><TD style="font-size:12pt;background:#FF99CC;color:#FFFFFF;" width=129>r</TD></TR><TR height=123><TD style="font-weight:bold;font-size:60pt;background:#0000FF;color:#000080;">f</TD><TD style="font-style:italic;font-size:32pt;background:#00FFFF;color:#800080;">H</TD><TD style="font-size:28pt;background:#666699;color:#FFFF99;">W</TD><TD style="font-weight:bold;font-style:italic;font-size:100pt;background:#808080;color:#000000;">1</TD></TR><TR height=89><TD style="font-weight:bold;font-size:24pt;background:#FF0000;color:#000000;">9</TD><TD style="font-size:70pt;background:#FFFFFF;color:#808080;">P</TD><TD style="font-size:18pt;background:#0000FF;color:#00FF00;">Q</TD><TD style="font-style:italic;font-size:45pt;background:#333399;color:#FF6600;">v</TD></TR><TR height=84><TD style="font-size:55pt;background:#000000;color:#CC99FF;">L</TD><TD style="font-weight:bold;font-size:18pt;background:#333300;color:#99CC00;">k</TD><TD style="font-size:42pt;background:#FF6600;color:#00CCFF;">j</TD><TD style="font-size:28pt;background:#008000;color:#808000;">3</TD></TR></TBODY></TABLE>

これをHTMLに埋め込んだものが↓です。

G	B	5	r
f	H	W	1
9	P	Q	v
L	k	j	3

文字の位置が違うようですね。
valign = "bottom"
を加えればより忠実に再現できそうです。

追記：
上のテーブルの中の文字の1部が切れています。
管理人ローカル環境では切れていなかったので
ココログ独自のスタイルシートが原因だと考え、
いろいろ設定してみました。
しかし、うまくいきませんでした。
ですのでサンプルページを用意しました。
こっちはこっちでフォントが違ってたりします。