【Word VBA】カーソル位置と同じアウトラインレベルの段落にカーソルを移動するWordマクロ

私はWordをアウトライナーとして使っています。(参考:【読み物】Wordをアウトライナーとして使う!

文章の目次作りで、同じアウトラインレベルの項目を行き来して内容を確認したり項目を移動したりする作業が発生します。

この行き来の作業に必要なのでこのマクロを作りました。

このマクロでできること

カーソルがある段落のアウトラインレベルと同じレベルの段落の先頭にカーソルが移動します。

上方向に移動する場合

下方向に移動する場合

マクロの解説

カーソルの移動先を探すために、アウトラインレベルでの検索をします。いつものようにRangeオブジェクトでFindメソッドを使います。

文字列ではなく書式で検索をしているので、36行目のText プロパティは空欄になっています。

その代わりに、37行目で段落書式のアウトラインレベルの設定をしています。ParagraphFormat.OutlineLevel プロパティです。このように書式を使った検索や置換がある場合には、40行目のFormat プロパティTrue にします。

マクロ


Sub カーソル移動_同レベル_進む()
 Call カーソル移動_同レベル(True)
End Sub

Sub カーソル移動_同レベル_戻る()
 Call カーソル移動_同レベル(False)
End Sub

Private Sub カーソル移動_同レベル(blnForward As Boolean)

 Dim myLevel As Long
 Dim myRange As Range
 
 '-------------------------------------------
 '前処理
 '-------------------------------------------
 
 'Rangeオブジェクトの設定(カーソルのある段落)
 Set myRange = Selection.Paragraphs(1).Range
 
 'Rangeオブジェクトのアウトラインレベルを取得
 myLevel = myRange.ParagraphFormat.OutlineLevel
 
 'カーソルの移動方向に応じてCollapseの方向を指定
 If blnForward = True Then
  myRange.Collapse wdCollapseEnd
 Else
  myRange.Collapse wdCollapseStart
 End If
 
 '-------------------------------------------
 '検索
 '-------------------------------------------
 
 With myRange.Find
  .Text = ""
  .ParagraphFormat.OutlineLevel = myLevel
  .Forward = blnForward
  .Wrap = wdFindAsk
  .Format = True
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchFuzzy = False
  .MatchWildcards = False
  If .Execute = True Then
   '見つけた場合、段落先頭にカーソルを移動
   myRange.Collapse wdCollapseStart
   myRange.Select
  End If
 End With

 '-------------------------------------------
 '後処理
 '-------------------------------------------
 
 'オブジェクト変数の解放
 Set myRange = Nothing
 
End Sub

トップへ戻る