Sub MyIndexesMarkEntry()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 選択文字列索引項目挿入処理
  Rem 作譜：Hitrock Camellia Shinopy
  Rem 言語：Word VBA
  Rem 機能...
  Rem   文書内にある太字の文字列を検索し、
  Rem   検索した文字列の索引項目を挿入する。
  Rem 注記...
  Rem   1. 太字の文字列を更に一旦[中抜き文字]書式を設定する。
  Rem   2. この処理後に、[索引の挿入]で索引を文書に挿入すること。
  Rem 履歴...
  Rem   第01版：2009/12/08：作成。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Selection.HomeKey Unit:=wdStory, Extend:=wdMove ' カーソル位置を文書の先頭まで移動。
  '
  With Selection.Find
    .ClearFormatting
    .Font.Bold = True ' 太字を検索。
    .Replacement.ClearFormatting
  End With
  With Selection.Find.Replacement.Font
    .Bold = True ' 太字に置換。
    .Outline = True ' 中抜き文字に置換。
  End With
  '
  With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = True
  End With
  Selection.Find.Execute Replace:=wdReplaceAll ' すべて置換。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Do
    ActiveWindow.ActivePane.View.ShowAll = True
    Application.Browser.Next ' 先の処理で検索した文字列へジャンプする。
    '
    Rem [中抜き文字]書式の文字列がなくなった場合は、索引項目を挿入を終了。
    If Selection.Range.Font.Outline = False Then Exit Do
    '
    Selection.Range.Font.Outline = False ' [中抜き文字]書式を設定解除。
    '
    Rem 選択した文字列の索引項目を挿入。
    ActiveDocument.Indexes.MarkEntry Range:=Selection.Range, Entry:=Selection.Range.Text, _
      EntryAutoText:=Selection.Range.Text, CrossReference:="", CrossReferenceAutoText:="", _
      BookmarkName:="", Bold:=False, Italic:=False, Reading:=""
    '
    ActiveWindow.ActivePane.View.ShowAll = False
    Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdMove
    DoEvents
  Loop
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Selection.HomeKey Unit:=wdStory, Extend:=wdMove ' カーソル位置を文書の先頭まで移動。
  ActiveWindow.ActivePane.View.ShowAll = False ' フィールドを非表示にする。
End Sub '  MyIndexesMarkEntry *----*----*    *----*----*    *----*----*    *----*----*