【コード】特定の文字列のフォント名を変更するWordマクロ

先日、お客様から、「ギリシャ文字をSymbolフォントで入力したい」との問い合わせがありました。

英文や和文を書くときに使いたいとのこと。

さらに、そのお客さんは、日本語をMS明朝にしてアルファベットをTimes New Romanに変換するマクロを実行しているとのことなのです。

このマクロを実行すると、書類中のフォントが一括で変換されてしまうので、文章を作成中にSymbolフォントを設定してもTimes New Roman等に変換されてしまうのです。

そのため、Symbolフォントの部分を再度1つ1つ設定する必要があって苦労しているとのことでした。

このようなお悩みを解決するために、Symbolフォントを最後に設定できるマクロを思いつきました。

このマクロでできること

マーカーの直後の1文字のフォントをSymbolに変換します。

変換された部分が「明るい緑色」で着色されます。

このマクロでは、マーカーを「2つの連続した半角の@」にしました。
対象ファイルで通常使われていない記述であれば、どのようなものでもかまいません。

(実行前)

(実行後)

上記の通り、@1つだけでは処理対象になりません。

マクロの解説

マーカーに@@ を用いて、この文字列をまず探します。

そして、Characters.Lastプロパティを使って、見つけた@@を特定するRange オブジェクトの最後の1文字を特定します。さらに、Nextメソッドにて、最後の1文字の次の1文字を特定します。

今回は、このNextメソッドで特定された1文字が処理対象の文字列です。

処理対象を特定できたので、あとは蛍光ペンで色をつけたりフォント名を変更したりできるのです。

マクロ


Sub Symbolフォントへ変換()

 Dim myRange As Range
 
 Set myRange = ActiveDocument.Range(0, 0)
 
 With myRange.Find
  .Text = "@@" 'マーカー
  .Forward = True
  .Wrap = wdFindStop
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = True
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchFuzzy = False
  Do While .Execute = True
   With myRange
    With .Characters.Last.Next
     .Font.Name = "Symbol"
     .HighlightColorIndex = wdBrightGreen
    End With
    .Delete
   End With
  Loop
 End With
 
 Set myRange = Nothing
 
End Sub

トップへ戻る