【コード】書式を蛍光ペンで着色するWordマクロ(その1)

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

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

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

このマクロでできること

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

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

マクロの解説

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

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

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

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

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

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

マクロ1(上付き)


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

マクロ2(下付き)


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

マクロ3(太字)


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

マクロ4(一重下線)


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

トップへ戻る