セル内のアンダーライン部分のみフォントを変える
文字列のうち、アンダーライン部分のフォントだけを変える
ツイッターのフォロワーさんの「漢字テストの問題をランダムに作成できんかなー」みたいなツイートに反応して、どうやったらできるのか考えてみた。
傍線部分だけゴシックにしないといけない
文字列に下線(傍線)を引くのは自動化できないにしても、下線部だけを狙い撃ちでフォントを変えるというのは、手作業でやると死ぬほどめんどくさい。
しかし、普段文字単位で書式をいじくることなんて皆無だから、どうしていいのか分からなかった。んで、調べてみると、Charactersオブジェクトを取得して書式を施せばよいと分かった。
Characters オブジェクトを使用すると、文字列のうちの一部だけを対象にした修正ができます。
Characters オブジェクトを取得するには、Characters(start, length) プロパティを使用します。引数 start には開始する文字の先頭位置の番号を指定します。引数 length には、文字数を指定します。
ということなので、なんとかなりそう。
考え方
次のような考え方でコードを書くことにした。
- 1文字目から順番にチェックする
- 初めてアンダーラインのある文字にぶつかったときにフラグを立て、何文字目かを変数tmpStartに記録する
- アンダーラインのない文字にぶつかったら、何文字目かを変数tmpEndに記録してループを抜ける
- Charactersオブジェクトの引数startにtmpStartを、引数lengthにtmpEnd - tmpStartを渡すと、アンダーライン部分のCharactersオブジェクトが取得できる
- 後は、4.で得られたCharactersオブジェクトのFontプロパティをあれこれいじくる
と、こんな感じ。
実装
リスト1
Private Sub changeFontIfUnderLine(ByVal objCell As Range, _ ByVal fontName As String) '下線が施された文字のフォントを変える' Dim i As Integer Dim hasStarted As Boolean Dim tmpStart As Integer Dim tmpEnd As Integer For i = 1 To Len(objCell.Value) With objCell.Characters(i, 1) '初めてアンダーラインにぶつかったときのiを記録する' If hasStarted = False And _ .Font.Underline <> xlUnderlineStyleNone Then tmpStart = i hasStarted = True End If 'hasStartedがTrueの状態でアンダーラインのない文字にぶつかったら' '下線部が終わったということなのでiを記録してループを抜ける。' If hasStarted = True And _ .Font.Underline = xlUnderlineStyleNone Then tmpEnd = i Exit For End If End With Next 'この時点でtmpEnd - tmpStartの値がアンダーライン文字列の字数' 'アンダーラインの部分のフォントを変える' objCell.Characters(tmpStart, tmpEnd - tmpStart).Font.Name = fontName End Sub
コード中のコメントでだいたい何をやっているのかは分かると思う。
全体の処理の途中で呼び出すメソッドのようなものなので、Privateにして呼び出され専用にしてある。引数で渡している処理対象セルやフォント名を決め打ちにしてやれば、単独のプロシージャとしても使えると思う。
実行結果
明朝体の「ケイオウカク」のところだけが、
無事にゴシック体になった。
おわりに
Charactersオブジェクトをうまく使えば、Excelのセル内の文字列に関するしちめんどくさい作業のかなりの部分を軽減できるようになるかも知れない。
いづれは、クラスを作って手軽に扱えるようにしてみたい。