VBA 税法条文のカッコ書き部分にオリジナルの書式を適用する。

クラスモジュール

クラスモジュールを挿入し、プロパティウィンドウからオブジェクト名をColorfulStringObjectに変更する。

ColorfulStringObjectのコードはこちら。

PrivateType ColorText
    TextPart AsString
    ColorPart As XlRgbColor
EndTypePrivate colorTextArray()As ColorText

PrivateSub Class_Initialize()ReDim colorTextArray(0)EndSubSub AddText(txt AsString,Optional col As XlRgbColor = rgbBlack)
    colorTextArray(UBound(colorTextArray)).ColorPart = col
    colorTextArray(UBound(colorTextArray)).TextPart = txt
    ReDimPreserve colorTextArray(UBound(colorTextArray)+1)EndSubFunctionGetText()Dim ret AsStringDim i AsLongFor i =0ToUBound(colorTextArray)-1
        ret = ret & colorTextArray(i).TextPart
    NextGetText= ret
EndFunctionSub WriteToCell(r As Range)
    r.Value=GetTextDim location AsLong: location =1For i =0ToUBound(colorTextArray)-1
        r.Characters(location,Len(colorTextArray(i).TextPart)) _.Font.color = colorTextArray(i).ColorPart
        location = location +Len(colorTextArray(i).TextPart)NextEndSub

標準モジュール

標準モジュールに次のコードを張り付ける。

Function RandomColor()AsLongDim r AsByte, g AsByte, b AsByte
    r = WorksheetFunction.RandBetween(0,255)
    g = WorksheetFunction.RandBetween(0,255)
    b = WorksheetFunction.RandBetween(0,255)
    RandomColor =RGB(r, g, b)EndFunction

↑カラー設計が面倒なので今回はランダムな色を扱えるように適当な色を返す関数を準備した。

次に、同じ標準モジュールに次のコードを張り付ける。

Sub DrawTheTextOfLawWithColor()Const MAX_NEST_DEPTH =10'適当に10色追加。実行の度にパレットが変わるので、'安定させたくば個別にコレクションに色をAddすべし。Dim colorPalette As Collection: Set colorPalette =New Collection
    Dim i AsLongFor i =1To MAX_NEST_DEPTH
        colorPalette.Add RandomColor
    Next'条文はB2セルに書く前提。サンプルなのでゴリゴリハードコーディング。Dim targetText AsString
    targetText = ThisWorkbook.Worksheets("Sheet1").Range("b2").ValueDim colorfulString As ColorfulStringObject
    Set colorfulString =New ColorfulStringObject
    Dim j AsLongDim nestDepth AsLong: nestDepth =1For j =1ToLen(targetText)Dim ch AsString: ch =Mid(targetText, j,1)Dim token AsStringSelectCase ch
        Case"（"
            colorfulString.AddText token, colorPalette(nestDepth)
            token =""
            colorfulString.AddText ch
            nestDepth = nestDepth +1Case"）"
            colorfulString.AddText token, colorPalette(nestDepth)
            token =""
            colorfulString.AddText ch
            nestDepth = nestDepth -1CaseElse
            token = token & ch
        EndSelectNext
    colorfulString.AddText token, colorPalette(nestDepth)
    
    colorfulString.WriteToCell ThisWorkbook.Worksheets("Sheet1").Range("B3")EndSub

Sheet1のB2から条文を読み取って、Sheet1のB3に色付きで出力させるマクロ完成。
何色になるかは神のみぞ知る。

ColorfulStringObjectについて

基本的に他人が作ったクラスは使い方さえ分かれば内部動作に気を配る必要はなく、ソースコードを詳細に読む必要もない。
ということで、ColorfulStringObjectは使い方に絞って説明する。

ColorfulStringObjectは3つのメソッドを持つオブジェクトである。

このうち基本的にはAddTextとWriteToCellを使用する。
サンプルコードはこちら。

Sub HowToUse()'オブジェクト使用のための準備Dim cso As ColorfulStringObject
    Set cso =New ColorfulStringObject
    
   'オブジェクトにテキストを蓄積
    cso.AddText "ABC",vbRed
    cso.AddText "DEF",vbGreen
    cso.AddText "GHI",vbBlue'セルに出力
    cso.WriteToCell Range("A1")EndSub

AddTextメソッドの引数にテキストと色情報を渡すと、次のように内部データ領域に蓄積され、WriteToCellでセルに出力される。

※AddTextで色を省略すると黒色になります。

標準モジュールのDrawTheTextOfLawWithColorについて

まずはカラーパレットを用意するコードから。

Dim colorPalette As Collection: Set colorPalette =New Collection
    Dim i AsLongFor i =1To MAX_NEST_DEPTH
        colorPalette.Add RandomColor
    Next

今回はMAX_NEST_DEPTHを10と定義したので、ランダムで10色作成してコレクションに入れた。
完成したコレクションのイメージはこんな感じ↓

次に、色付けするテキストをtargetText変数に入れる。

Dim targetText AsString
    targetText = ThisWorkbook.Worksheets("Sheet1").Range("b2").Value

次に、ColorfulStringObjectの準備。

Dim colorfulString As ColorfulStringObject
    Set colorfulString =New ColorfulStringObject

次にネストの深さを示す変数nestDepthを1にしておく。

Dim nestDepth AsLong: nestDepth =1

このnestDepthは"（"が見つかると増え、"）"が見つかると減る仕組み。
たとえばtargetTextが“あああ（いいい（うう）ええ）お”だとすると、それぞれの文字読み込み時点のnestDepthは次のようになる。

nestDepthの値は、最初に作ったカラーパレットコレクションのインデックスと対応して色を決めている。

今説明したことを行うコードがこちら。

For j =1ToLen(targetText)Dim ch AsString: ch =Mid(targetText, j,1)Dim token AsStringSelectCase ch
        Case"（"
            colorfulString.AddText token, colorPalette(nestDepth)
            token =""
            colorfulString.AddText ch
            nestDepth = nestDepth +1Case"）"
            colorfulString.AddText token, colorPalette(nestDepth)
            token =""
            colorfulString.AddText ch
            nestDepth = nestDepth -1CaseElse
            token = token & ch
        EndSelectNext
    colorfulString.AddText token, colorPalette(nestDepth)

これをざくっと日本語に置き換えるとこんな感じ↓

    For j = 1 To targetTextの文字数まで
        変数chに1文字いれる｡
        Select Case ch
        Case "（"
            colofulStringにtokenを追加し､
            tokenをクリアしてから､
            colofulStringに"（"を追加する。
            そして､nestDepthを増やす｡
        Case "）"
            colofulStringにtokenを追加し､
            tokenをクリアしてから､
            colofulStringに"）"を追加する。
            そして､nestDepthを減らす｡
        Case Else
            変数tokenに文字を継ぎ足す｡
        End Select
    Next
    ループ終了後にcolofulStringに未追加のtokenを追加する｡

※For文の中に変数宣言があるけどこれは気にしない。宣言は1回しか処理されないので外に書いても中に書いても同じ。

あとは、セルに出力するだけ。

    colorfulString.WriteToCell ThisWorkbook.Worksheets("Sheet1").Range("B3")

以上。