VBA クラスモジュールを使ってセル内の文字を簡単に色づけ

f:id:t-hom:20170207200918p:plain

VBAでセル内のテキストの個別の文字に色をつけるのはわりに面倒くさい。

たとえばこんな風に、着色したいとしよう。
f:id:t-hom:20170207201819p:plain

上のテキストを実現するには、以下のコードを書けば良い。

Sub hoge()
    Sheet1.Range("A1").Value = "Red, Green, Blue"
    Sheet1.Range("A1").Font.Color = vbBlack
    Sheet1.Range("A1").Characters(1, 3).Font.Color = rgbRed
    Sheet1.Range("A1").Characters(6, 5).Font.Color = rgbGreen
    Sheet1.Range("A1").Characters(13, 4).Font.Color = rgbBlue
End Sub

ここで面倒なのが、Charactorsプロパティに指定する文字数。
「何文字目から、何文字を」という指定をしないといけないけど、頭がこんがらがる。

これ、もう少しなんとかならんかな。。

というわけで、クラスモジュールを使って少し楽にカラフルな文字列を作れるようにしてみた。

作り方

クラスモジュールを挿入し、モジュール名を「ColorfulStringObject」と名づける。
コードはこちら。

Private Type ColorText
    TextPart As String
    ColorPart As XlRgbColor
End Type
Private colorTextArray() As ColorText

Private Sub Class_Initialize()
    ReDim colorTextArray(0)
End Sub

Sub AddText(txt As String, Optional col As XlRgbColor = rgbBlack)
    colorTextArray(UBound(colorTextArray)).ColorPart = col
    colorTextArray(UBound(colorTextArray)).TextPart = txt
    ReDim Preserve colorTextArray(UBound(colorTextArray) + 1)
End Sub

Function GetText()
    Dim ret As String
    Dim i As Long
    For i = 0 To UBound(colorTextArray) - 1
        ret = ret & colorTextArray(i).TextPart
    Next
    GetText = ret
End Function

Sub WriteToCell(r As Range)
    r.Value = GetText
    Dim location As Long: location = 1
    For i = 0 To UBound(colorTextArray) - 1
        r.Characters(location, Len(colorTextArray(i).TextPart)) _
            .Font.Color = colorTextArray(i).ColorPart
        location = location + Len(colorTextArray(i).TextPart)
    Next
End Sub

準備はこれだけ。
このクラスを作るにあたって工夫した点として、クラス内部にPrivateのユーザー定義型「ColorText」を宣言し、それを配列に入れているところ。通常クラス内にPublicなユーザー定義型は宣言できないが、Privateなら問題ない。

ユーザー定義型はコレクションに追加できないのが残念だが、コレクションを使いたいだけのために外部にオブジェクトを作るのも面倒なので、ワンモジュールで完結するようにユーザー定義型の配列にした。

使い方

先ほどのRed, Green, Blueを表示させるには、標準モジュール等に以下のように書く。

Sub ColorRGB()
    Dim colorfulString As ColorfulStringObject
    Set colorfulString = New ColorfulStringObject
    colorfulString.AddText "Red", rgbRed
    colorfulString.AddText ", "
    colorfulString.AddText "Green", rgbGreen
    colorfulString.AddText ", "
    colorfulString.AddText "Blue", rgbBlue
    colorfulString.WriteToCell Sheet1.Range("a1")
End Sub

AddTextメソッドに文字列と色を渡すと内部でColorText型の配列に保管される。
つまり、文字列全体を書いてから位置指定で着色するのではなく、最初からこの文字を赤で、この文字を緑でという風に追加していくのだ。
最後にWriteToCellメソッドにRangeを渡すと、そのRangeに実際にカラーで書き込まれる仕組み。

注意点として、VBAではRangeのValueプロパティを触ると色がリセットされてしまう。
そのためAddTextでは直接セルに書かず、最後にWriteToCallを呼ぶ仕様とした。

今回引数としてxlRgbColor列挙型を使用してみた。これは過去に以下の記事で紹介したもの。
thom.hateblo.jp

プロシージャの引数として列挙型を指定してやると、呼び出す側で入力ヒントが出るので便利。
f:id:t-hom:20170207203153p:plain

列挙型の実態はLongなのでRGB関数で作成した色や、vbのcolor定数(vbRedなど)も指定できる。

以下、別のサンプル。

■ランダムな色でHello, VBA!!を表示する。
f:id:t-hom:20170207203352p:plain

Sub RandomColorHelloVBA()
    Const MESSAGE = "Hello, VBA!!"
    Dim colorfulString As ColorfulStringObject
    Set colorfulString = New ColorfulStringObject
    Dim i As Long
    For i = 1 To Len(MESSAGE)
        Dim r As Byte, g As Byte, b As Byte
        r = WorksheetFunction.RandBetween(0, 255)
        g = WorksheetFunction.RandBetween(0, 255)
        b = WorksheetFunction.RandBetween(0, 255)
        colorfulString.AddText Mid(MESSAGE, i, 1), RGB(r, g, b)
    Next
    colorfulString.WriteToCell Sheet1.Range("a2")
End Sub

■SQLの色分け
f:id:t-hom:20170207203443p:plain

Sub ColorSQL()
    Dim colorfulString As ColorfulStringObject
    Set colorfulString = New ColorfulStringObject
    colorfulString.AddText "select", rgbBlue
    colorfulString.AddText " * "
    colorfulString.AddText "from", rgbBlue
    colorfulString.AddText " people_table "
    colorfulString.AddText "where", rgbBlue
    colorfulString.AddText " age "
    colorfulString.AddText ">=", rgbMaroon
    colorfulString.AddText " 20"
    colorfulString.WriteToCell Sheet1.Range("a3")
End Sub