指定した文字列のフォントを狙い撃ちで変えるマクロ[Word]
Wordで指定した文字列だけ狙い撃ちでフォントを変えるマクロ
文字列単位でフォントを変える
1文字単位でフォントを変える、というのは過去にやったことがあるが、それだと巻き添えで関係のないところまでフォントが変わってしまうので、ちょっとメンドクサかった。
たとえば、「ファラオ」という文字列をゴシックにしたかったとして、「ラはファラオのラ~♪」という文字列に対して「ファ」、「ラ」、「オ」の1字づつをゴシックに変える処理をすると、当然巻き添えで音階を表す「ラ」までゴシックになってしまう、ということだ。
まあ、完全に巻き添え事故を防ぐことは難しいにせよ、文字列単位でフォントを変える、ということができれば、かなり減らすことはできると考えた。
考え方
ただ、文字列全体から任意の文字列を切り出すだけなら Mid関数 を使えば楽勝だが、悲しいことにフォントを変えるためにはFontオブジェクトにアクセスせねばならず、文字列を切り出しても仕方がない。
で、次のように考えた。
- まず、文字列全体をCharactersコレクションとして取得する。
- x 番目のCharacterオブジェクトから、比較対象文字列(フォントを変えたい文字列)の文字数分だけ切り出して、文字列を作る。
- 2.で作成した文字列を比較対象文字列と比較する。
- 3.の結果が同じであれば、 x 番目のCharacterオブジェクトから、 x + (比較対象文字列の文字数) - 1 番目のCharacterオブジェクトまでのFont.Nameプロパティを変更したいフォント名にする。
- 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 ゴシック」になるということだ。
ドキュメント上にこんな文章を用意して、
こんなふうに文字列を選択した状態で実行すると、
ほれ、この通り。
狙い通りの結果になっている。
おわりに
実行にえらく時間がかかるので、たぶんあんまり良くないやり方なんだろうなあ……。
追記
コチラもどうぞ!