指定した文字列のフォントを狙い撃ちで変えるマクロ[Word]

Wordで指定した文字列だけ狙い撃ちでフォントを変えるマクロ

文字列単位でフォントを変える

1文字単位でフォントを変える、というのは過去にやったことがあるが、それだと巻き添えで関係のないところまでフォントが変わってしまうので、ちょっとメンドクサかった。

たとえば、「ファラオ」という文字列をゴシックにしたかったとして、「ラはファラオのラ~♪」という文字列に対して「ファ」、「ラ」、「オ」の1字づつをゴシックに変える処理をすると、当然巻き添えで音階を表す「ラ」までゴシックになってしまう、ということだ。

f:id:akashi_keirin:20180127090830j:plain

まあ、完全に巻き添え事故を防ぐことは難しいにせよ、文字列単位でフォントを変える、ということができれば、かなり減らすことはできると考えた。

考え方

ただ、文字列全体から任意の文字列を切り出すだけなら Mid関数 を使えば楽勝だが、悲しいことにフォントを変えるためにはFontオブジェクトにアクセスせねばならず、文字列を切り出しても仕方がない。

で、次のように考えた。

  1. まず、文字列全体をCharactersコレクションとして取得する。
  2. x 番目のCharacterオブジェクトから、比較対象文字列(フォントを変えたい文字列)の文字数分だけ切り出して、文字列を作る。
  3. 2.で作成した文字列を比較対象文字列と比較する。
  4. 3.の結果が同じであれば、 x 番目のCharacterオブジェクトから、 x + (比較対象文字列の文字数) - 1 番目のCharacterオブジェクトまでのFont.Nameプロパティを変更したいフォント名にする。
  5. 2.~4.を文字列全体の字数 - 比較対象文字列の字数 + 1 回繰り返す。

このように考えた。

コーディング

上記の考えに基づいて以下のコードを書いた。

リスト1ー1 標準モジュール
Public Function applyFontType(ByVal targetSentences As Word.Characters, _
                              ByVal compareTo As String, _
                              ByVal nameOfFont As String) As Boolean
  Dim maxCount As Integer
  maxCount = targetSentences.Count
  Dim wordCount As Integer
  wordCount = Len(compareTo)
  Dim i As Integer
  Dim str As String
  For i = 1 To maxCount - wordCount + 1
    str = assembleWordFromChar(targetSentences:=targetSentences, _
                               extractFrom:=i, _
                               extractTo:=i + wordCount - 1)
    If str = compareTo Then
      Call applyFont(targetSentences:=targetSentences, _
                     startFrom:=i, _
                     endAt:=i + wordCount - 1, _
                     nameOfFont:=nameOfFont)
    End If
  Next
  applyFontType = True
End Function

引数に文字列全体、比較対象文字列、変更したいフォント名を与えると、比較対象文字列の部分のフォントを変え、処理が無事に終わったらTrueを返すFunctionにしている。

リスト1ー2 標準モジュール
Private Function assembleWordFromChar(ByVal targetSentences As Word.Characters, _
                                      ByVal extractFrom As Integer, _
                                      ByVal extractTo As Integer) As String
  Dim i As Integer
  Dim str As String
  For i = extractFrom To extractTo
    str = str & targetSentences(i)
  Next
  assembleWordFromChar = str
End Function

こいつは、指定された字数分の文字列をCharactersコレクションから作り出すFunction。

リスト1ー3 標準モジュール
Private Sub applyFont(ByVal targetSentences As Word.Characters, _
                      ByVal startFrom As Integer, _
                      ByVal endAt As Integer, _
                      ByVal nameOfFont As String)
  Dim i As Integer
  For i = startFrom To endAt
    targetSentences(i).Font.Name = nameOfFont
  Next
End Sub

んで、こいつが、Charactersコレクションの指定された範囲のFont.Nameプロパティを変更するSub。

ほとんどコイツをそのままコードに置き換えただけ。

実験

次のコードで実行した。

スト2 標準モジュール
Public Sub testApplyFontType()
  Dim ar As Variant
  ar = Array("ち~んw", "プヒー!", "(゚Д゚)ハァ?")
  Dim i As Integer
  For i = 0 To 2
    If Not applyFontType(targetSentences:=Selection.Characters, _
                         compareTo:=ar(i), _
                         nameOfFont:="MS ゴシック") Then
      Call makeUserSick("失敗www")
      Exit Sub
    End If
  Next
End Sub

短いコードなので、見たら分かると思うが、配列変数 ar に、「ち~んw」、「プヒー!」、「(゚Д゚)ハァ?」の3つの文字列を持たせて、それをForループで回してapplyFontTypeの引数として渡して実行している。

第1引数には、

Selection.Characters

を指定しているので、文書上の選択した範囲の文字列のうち、「ち~んw」、「プヒー!」、「(゚Д゚)ハァ?」となっている部分のフォントが「MS ゴシック」になるということだ。

f:id:akashi_keirin:20180121194454j:plain

ドキュメント上にこんな文章を用意して、

f:id:akashi_keirin:20180121194502j:plain

こんなふうに文字列を選択した状態で実行すると、

f:id:akashi_keirin:20180121194512j:plain

ほれ、この通り。

狙い通りの結果になっている。

おわりに

実行にえらく時間がかかるので、たぶんあんまり良くないやり方なんだろうなあ……。

追記

akashi-keirin.hatenablog.com

コチラもどうぞ!