VBAでセル内のテキストの個別の文字に色をつけるのはわりに面倒くさい。
たとえばこんな風に、着色したいとしよう。
上のテキストを実現するには、以下のコードを書けば良い。
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
プロシージャの引数として列挙型を指定してやると、呼び出す側で入力ヒントが出るので便利。
列挙型の実態はLongなのでRGB関数で作成した色や、vbのcolor定数(vbRedなど)も指定できる。
以下、別のサンプル。
■ランダムな色でHello, VBA!!を表示する。
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の色分け
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
工夫すればRangeへの出力だけでなくHTML出力なんかも作れるかと思う。
以上