先日ご紹介した「Word文書中の蛍光ペンのテキストを抽出するマクロ 」へいただいたコメントから作成してみました。
蛍光ペンの色指定をする方法は、「Word 蛍光ペンの色を入れ替えるマクロ 」や、「特定の蛍光ペンを消すマクロ 」で紹介したとおりです。
今回は、Word 蛍光ペンの色を入れ替えるマクロ の方法を用いました。
＜目次＞
マクロの解説
Wordの基本機能では、蛍光ペンの色を指定して検索したり置換したりすることができません。ただし、蛍光ペンの有無についての判定や蛍光ペン（色の指定なし）に基づいて検索や置換を行うことができます。
なので、こういうときはマクロの出番ですね。
マクロを用いて、以下のような操作をします。
（１）蛍光ペンの箇所を探す
（２）現在選択されている蛍光ペンの色を判定して、指定された色であれば、特定の処理を行う。それ以外の色であれば、別の蛍光ペンの箇所を探す
もっと詳しく
25行目～27行目の解説です。
ただ、やっかいなのは、蛍光ペンの色が複数連続して表示される場合（下図の「あいうえお」のような状態）には、蛍光ペンの色を特定できないので、undefined と判定されます。
この場合には、単独の色が選択された状態となるように、選択範囲末端のを徐々に狭めて単独の色だけが使われた状態で、色の判定をします。
たとえば、「あいうえお」が選択されている状態であれば、「あ」だけを選択されている状態にしてから色の判定をします。
そして、29行目～50行目で選択部分の色を判定して処理を実行します。
マクロ
Sub 蛍光ペンのテキスト抽出_色指定() Dim myRange As Range 'Rangeオブジェクト Dim myText As String '抽出する文字列 Dim newDoc As Document '新規で開いた文書 '画面の更新をオフ Application.ScreenUpdating = False Set myRange = ActiveDocument.Range(0, 0) Set newDoc = Documents.Add With myRange.Find .Text = "" .Forward = True .Wrap = wdFindStop .Highlight = True End With '文書の最後の蛍光ペン後は、蛍光ペンが 'なくても検索されたと判定されることがあるため回避する処理 Do While myRange.Find.Execute = True And _ myRange.Text <> "" Do While myRange.HighlightColorIndex = wdUndefined myRange.MoveEnd Unit:=wdCharacter, Count:=-1 Loop If myRange.HighlightColorIndex = wdRed Then If InStr(myRange.Text, vbCr) Then If myRange.Text <> vbCr Then myRange.End = myRange.End - 1 With newDoc.Range .InsertAfter myRange.Text .InsertParagraphAfter myRange.Collapse direction:=wdCollapseEnd End With Else '蛍光ペンが改行記号の場合は無視 End If Else With newDoc.Range .InsertAfter myRange.Text .InsertParagraphAfter myRange.Collapse direction:=wdCollapseEnd End With End If End If Loop Set newDoc = Nothing Set myRange = Nothing '画面の更新をオン Application.ScreenUpdating = True End Sub