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

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

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

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

このマクロでできること

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

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

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

マクロの解説

文字列が選択されているかどうかは、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 "蛍光ペン1色の文字列を選択してください。"
   Exit Sub
  Else
   '見つけた蛍光ペンの範囲に複数の色が含まれる場合は
   '1色になるまで選択範囲を狭める
   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
   
   '見つけた蛍光ペンの範囲に複数の色が含まれる場合は
   '1色になるまで選択範囲を狭める
   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マクロ

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

トップへ戻る