【Word VBA】特定の蛍光色にカーソルをジャンプするWordマクロ

2013年10月7日

, ,

本文中に様々な色の蛍光ペンを使ってマーキングしたときに、特定の色の蛍光ペン個所を確認する場合があります。

その時に、蛍光ペンの色を指定して検索できたらいいですよね。

お客様から要望をいただきましたので作ってみました。

このマクロでできること

カーソルが置かれている位置の蛍光ペンの色を検出し、その色で着色されている部分にカーソルを移動させます。

文字列が選択されていない場合には、自動的に「単語」単位（Wordが識別する単語です）で選択範囲を拡大させ、蛍光ペンの色を調べます。

「単語」内に複数の蛍光ペンが用いられていた場合には、単語の先頭１文字の蛍光ペンの色が採用されます。

マクロの解説

文字列が選択されているかどうかは、6行目～8行目で調べています。
選択されていない場合、単語単位で選択範囲を拡大します。

 

選択範囲内の蛍光ペンの色を調べる手法は、以前の記事（蛍光ペンの色を入れ替えるWordマクロ ）のものを用いました。

 

58行目～60行目で一度カーソルを文末に移動させています。

こうすると、検索した蛍光個所が画面の一番上に表示されます。

この考え方は、以前の記事（日英特許明細書の段落番号を探すマクロ（改良版） ）のSelection.EndKey Unit:=wdStoryと同じです。

マクロ


Sub 特定の蛍光色にカーソルをジャンプ()

　Dim myRange As Range
　Dim myColor As String
　
　If Selection.Type = wdSelectionIP Then
　　Selection.Expand unit:=wdWord
　End If
　
　With Selection
　　'選択範囲に蛍光ペンがない場合
　　If .Range.HighlightColorIndex = wdNoHighlight Then
　　　MsgBox "蛍光ペン１色の文字列を選択してください。"
　　　Exit Sub
　　Else
　　　'見つけた蛍光ペンの範囲に複数の色が含まれる場合は
　　　'１色になるまで選択範囲を狭める
　　　Do While .Range.HighlightColorIndex = wdUndefined
　　　　.MoveEnd unit:=wdCharacter, Count:=-1
　　　Loop
　　　'蛍光ペンの色を格納
　　　myColor = .Range.HighlightColorIndex
　　End If
　End With
　
　'画面の更新を中止
　Application.ScreenUpdating = False
　
　Set myRange = Selection.Range
　
　'下方向に蛍光ペン個所を検索をする
　With myRange.Find
　　.Text = ""　　'検索する文字列
　　.Forward = True
　　.Wrap = wdFindAsk
　　.Format = True　　　　　　　'書式の設定をオン
　　.Highlight = True　　　　　 '蛍光ペンをオン
　　.MatchCase = False　　　　　'大文字と小文字の区別する
　　.MatchWholeWord = False　　 '完全に一致する単語だけを検索する
　　.MatchAllWordForms = False　'英単語の異なる活用形を検索する
　　.MatchSoundsLike = False　　'あいまい検索（英）
　　.MatchFuzzy = False　　　　 'あいまい検索（日）
　　.MatchWildcards = False　　 'ワイルドカードを使用する
　　.MatchByte = False　　　　　 '半角と全角を区別する
　　
　　Do While .Execute = True
　　　
　　　'見つけた蛍光ペンの範囲に複数の色が含まれる場合は
　　　'１色になるまで選択範囲を狭める
　　　Do While myRange.HighlightColorIndex = wdUndefined
　　　　myRange.MoveEnd unit:=wdCharacter, Count:=-1
　　　Loop
　　　DoEvents
　　　
　　　If myRange.HighlightColorIndex = myColor Then
　　　　
　　　　'カーソルを末尾に移動
　　　　With ActiveDocument
　　　　　.Range(.Range.End - 1, .Range.End - 1).Select
　　　　End With
　　　　
　　　　'選択
　　　　myRange.Select
　　　　Exit Do
　　　　
　　　End If
　　　
　　　'選択個所を解除
　　　myRange.Collapse direction:=wdCollapseEnd
　　
　　Loop
　End With

　'myRangeを解放
　Set myRange = Nothing
　
　'画面を更新
　Application.ScreenUpdating = True

End Sub

関連記事

蛍光ペンの色を入れ替えるWordマクロ

日英特許明細書の段落番号を探すマクロ（改良版）

-コード
-, ,