セル内のアンダーライン部分のみフォントを変える - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

文字列のうち、アンダーライン部分のフォントだけを変える

ツイッターのフォロワーさんの「漢字テストの問題をランダムに作成できんかなー」みたいなツイートに反応して、どうやったらできるのか考えてみた。

傍線部分だけゴシックにしないといけない

文字列に下線（傍線）を引くのは自動化できないにしても、下線部だけを狙い撃ちでフォントを変えるというのは、手作業でやると死ぬほどめんどくさい。

しかし、普段文字単位で書式をいじくることなんて皆無だから、どうしていいのか分からなかった。んで、調べてみると、Charactersオブジェクトを取得して書式を施せばよいと分かった。

Characters オブジェクトを使用すると、文字列のうちの一部だけを対象にした修正ができます。

Characters オブジェクトを取得するには、Characters(start, length) プロパティを使用します。引数 start には開始する文字の先頭位置の番号を指定します。引数 length には、文字数を指定します。

ということなので、なんとかなりそう。

考え方

次のような考え方でコードを書くことにした。

１文字目から順番にチェックする
初めてアンダーラインのある文字にぶつかったときにフラグを立て、何文字目かを変数tmpStartに記録する
アンダーラインのない文字にぶつかったら、何文字目かを変数tmpEndに記録してループを抜ける
Charactersオブジェクトの引数startにtmpStartを、引数lengthにtmpEnd - tmpStartを渡すと、アンダーライン部分のCharactersオブジェクトが取得できる
後は、4.で得られたCharactersオブジェクトのFontプロパティをあれこれいじくる

と、こんな感じ。

実装

リスト１

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にして呼び出され専用にしてある。引数で渡している処理対象セルやフォント名を決め打ちにしてやれば、単独のプロシージャとしても使えると思う。