【Word VBA】書式を蛍光ペンで着色するWordマクロ（その１）

2022/10/23 コード 0
, , 

2014年8月7日　追記
応用版を公開しました。
【コード】書式を蛍光ペンで着色するWordマクロ（その２）

お客様から、「上付き文字や下付き文字をマーキングできないでしょうか？」という問い合わせをいただきました。

書式のチェックに役立ちそうですね。
このような場合は、蛍光ペンで着色すると見やすくてよいと思います。

このマクロでできること

本文中の特定の文字書式（上付き、下付き、太字、一重下線）を蛍光ペンでマーキングします。

ヘッダーやコメントなどの文字書式は処理対象外です。

マクロの解説

Rangeオブジェクトを用いたマクロです。

「検索と置換」ダイアログボックスの設定項目に沿ったプロパティを設定します。
項目名で示した通り、検索オプションはオフにしました。

蛍光ペンの色が「色なし」の場合には、強制的に黄色に設定します。
それ以外の場合、選択されている色でマーキングします。

4つのマクロを紹介しました。検索する文字列の書式が異なります。

書式情報を検索条件にする場合には、.Format プロパティをオンにします。（30行目）

「検索する文字列」と「置換後の文字列」とは、両方とも空欄です。書式を検索したり、書式を置換後の文字列にあてはめる場合、文字列を入れる必要はありません。

マクロ１（上付き）


Sub　蛍光ペン_上付き()

　Dim myRange As Range
　Dim myColor As String　'蛍光ペンの色
　
　'-----------------------------------
　'蛍光ペンの色の設定
　'-----------------------------------
　'現在選択されている蛍光ペンの色が「色なし」の場合
　'マーカー用の蛍光ペンの色を一時的に「黄色」に設定する
　If Options.DefaultHighlightColorIndex = wdNoHighlight Then
　　'現在選択されている蛍光ペンの色（「色なし」です）の保存
　　myColor = Options.DefaultHighlightColorIndex
　　'蛍光ペンの色を黄色に設定
　　Options.DefaultHighlightColorIndex = wdYellow
　End If
　
　'-----------------------------------
　'Rangeオブジェクトの設定・置換
　'-----------------------------------
　Set myRange = ActiveDocument.Range(0, 0)
　
　With myRange.Find
　　.Text = "" '検索する文字列
　　.Font.Superscript = True　'検索する文字列の書式：上付き
　　.Replacement.Text = ""　'置換後の文字列
　　.Replacement.Highlight = True　'置換後の文字列の蛍光ペン
　　.Forward = True
　　.Wrap = wdFindStop
　　.Format = True　　　　　　 '書式：オン
　　.MatchCase = False　　　　 '大文字と小文字の区別する
　　.MatchWholeWord = False　　'完全に一致する単語だけを検索する
　　.MatchByte = False　　　　 '半角と全角を区別する
　　.MatchAllWordForms = False '英単語の異なる活用形を検索する
　　.MatchSoundsLike = False　 'あいまい検索（英）
　　.MatchFuzzy = False　　　　'あいまい検索（日）
　　.MatchWildcards = False　　'ワイルドカードを使用する
　　.Execute Replace:=wdReplaceAll　'すべてを置換する　を実行
　End With

　'-----------------------------------
　'蛍光ペンの色の再設定
　'-----------------------------------
　If myColor <> "" Then
　　Options.DefaultHighlightColorIndex = myColor
　End If
　
　'-----------------------------------
　'Rangeオブジェクトの解放
　'-----------------------------------
　Set myRange = Nothing
　
End Sub

マクロ２（下付き）


Sub　蛍光ペン_下付き()

　Dim myRange As Range
　Dim myColor As String　'蛍光ペンの色
　
　'-----------------------------------
　'蛍光ペンの色の設定
　'-----------------------------------
　'現在選択されている蛍光ペンの色が「色なし」の場合
　'マーカー用の蛍光ペンの色を一時的に「黄色」に設定する
　If Options.DefaultHighlightColorIndex = wdNoHighlight Then
　　'現在選択されている蛍光ペンの色（「色なし」です）の保存
　　myColor = Options.DefaultHighlightColorIndex
　　'蛍光ペンの色を黄色に設定
　　Options.DefaultHighlightColorIndex = wdYellow
　End If
　
　'-----------------------------------
　'Rangeオブジェクトの設定・置換
　'-----------------------------------
　Set myRange = ActiveDocument.Range(0, 0)
　
　With myRange.Find
　　.Text = ""
　　.Font.Subscript = True　'検索する文字列の書式：下付き
　　.Replacement.Text = ""
　　.Replacement.Highlight = True　'置換後の文字列の蛍光ペン
　　.Forward = True
　　.Wrap = wdFindStop
　　.Format = True　　　　　　 '書式：オン
　　.MatchCase = False　　　　 '大文字と小文字の区別する
　　.MatchWholeWord = False　　'完全に一致する単語だけを検索する
　　.MatchByte = False　　　　 '半角と全角を区別する
　　.MatchAllWordForms = False '英単語の異なる活用形を検索する
　　.MatchSoundsLike = False　 'あいまい検索（英）
　　.MatchFuzzy = False　　　　'あいまい検索（日）
　　.MatchWildcards = False　　'ワイルドカードを使用する
　　.Execute Replace:=wdReplaceAll　'すべてを置換する　を実行
　End With

　'-----------------------------------
　'蛍光ペンの色の再設定
　'-----------------------------------
　If myColor <> "" Then
　　Options.DefaultHighlightColorIndex = myColor
　End If
　
　'-----------------------------------
　'Rangeオブジェクトの解放
　'-----------------------------------
　Set myRange = Nothing
　
End Sub

マクロ３（太字）


Sub　蛍光ペン_太字()

　Dim myRange As Range
　Dim myColor As String　'蛍光ペンの色
　
　'-----------------------------------
　'蛍光ペンの色の設定
　'-----------------------------------
　'現在選択されている蛍光ペンの色が「色なし」の場合
　'マーカー用の蛍光ペンの色を一時的に「黄色」に設定する
　If Options.DefaultHighlightColorIndex = wdNoHighlight Then
　　'現在選択されている蛍光ペンの色（「色なし」です）の保存
　　myColor = Options.DefaultHighlightColorIndex
　　'蛍光ペンの色を黄色に設定
　　Options.DefaultHighlightColorIndex = wdYellow
　End If
　
　'-----------------------------------
　'Rangeオブジェクトの設定・置換
　'-----------------------------------
　Set myRange = ActiveDocument.Range(0, 0)
　
　With myRange.Find
　　.Text = ""
　　.Font.Bold = True　'検索する文字列の書式：太字
　　.Replacement.Text = ""
　　.Replacement.Highlight = True　'置換後の文字列の蛍光ペン
　　.Forward = True
　　.Wrap = wdFindStop
　　.Format = True　　　　　　 '書式：オン
　　.MatchCase = False　　　　 '大文字と小文字の区別する
　　.MatchWholeWord = False　　'完全に一致する単語だけを検索する
　　.MatchByte = False　　　　 '半角と全角を区別する
　　.MatchAllWordForms = False '英単語の異なる活用形を検索する
　　.MatchSoundsLike = False　 'あいまい検索（英）
　　.MatchFuzzy = False　　　　'あいまい検索（日）
　　.MatchWildcards = False　　'ワイルドカードを使用する
　　.Execute Replace:=wdReplaceAll　'すべてを置換する　を実行
　End With

　'-----------------------------------
　'蛍光ペンの色の再設定
　'-----------------------------------
　If myColor <> "" Then
　　Options.DefaultHighlightColorIndex = myColor
　End If
　
　'-----------------------------------
　'Rangeオブジェクトの解放
　'-----------------------------------
　Set myRange = Nothing
　
End Sub

 

マクロ４（一重下線）


Sub　蛍光ペン_太字()

　Dim myRange As Range
　Dim myColor As String　'蛍光ペンの色
　
　'-----------------------------------
　'蛍光ペンの色の設定
　'-----------------------------------
　'現在選択されている蛍光ペンの色が「色なし」の場合
　'マーカー用の蛍光ペンの色を一時的に「黄色」に設定する
　If Options.DefaultHighlightColorIndex = wdNoHighlight Then
　　'現在選択されている蛍光ペンの色（「色なし」です）の保存
　　myColor = Options.DefaultHighlightColorIndex
　　'蛍光ペンの色を黄色に設定
　　Options.DefaultHighlightColorIndex = wdYellow
　End If
　
　'-----------------------------------
　'Rangeオブジェクトの設定・置換
　'-----------------------------------
　Set myRange = ActiveDocument.Range(0, 0)
　
　With myRange.Find
　　.Text = ""
　　.Font.Underline = wdUnderlineSingle　'検索する文字列の書式：一重下線
　　.Replacement.Text = ""
　　.Replacement.Highlight = True　'置換後の文字列の蛍光ペン
　　.Forward = True
　　.Wrap = wdFindStop
　　.Format = True　　　　　　 '書式：オン
　　.MatchCase = False　　　　 '大文字と小文字の区別する
　　.MatchWholeWord = False　　'完全に一致する単語だけを検索する
　　.MatchByte = False　　　　 '半角と全角を区別する
　　.MatchAllWordForms = False '英単語の異なる活用形を検索する
　　.MatchSoundsLike = False　 'あいまい検索（英）
　　.MatchFuzzy = False　　　　'あいまい検索（日）
　　.MatchWildcards = False　　'ワイルドカードを使用する
　　.Execute Replace:=wdReplaceAll　'すべてを置換する　を実行
　End With

　'-----------------------------------
　'蛍光ペンの色の再設定
　'-----------------------------------
　If myColor <> "" Then
　　Options.DefaultHighlightColorIndex = myColor
　End If
　
　'-----------------------------------
　'Rangeオブジェクトの解放
　'-----------------------------------
　Set myRange = Nothing
　
End Sub
トップへ戻る