先日、お客様から、「ギリシャ文字を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