Sub MyBookmark()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem ブックマーク飛び越し処理
  Rem 作譜：Hitrock Camellia Shinopy
  Rem 言語：Word VBA
  Rem 機能：選択したブックマークを指定してジャンプ。
  Rem 注記...
  Rem   MyBookmarkを起動して使用｡
  Rem   一つの文書で使う時のみ、この処理は有効。
  Rem   （他の文書を開いてこの処理を起動すると、誤作動する。）
  Rem 履歴...
  Rem   第1版：2003/10/18：作成。
  Rem   第2版：2004/03/26：不具合を修正。
  Rem   第3版：2005/06/13：モードレス化。
  Rem   第4版：2007/01/31：バルーン表示を廃止。ツールバー表示に変更。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Dim myFaceId As Long
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If ActiveDocument.Bookmarks.Count <= 0 Then
    MsgBox "この文書には、ブックマークがありません。", vbExclamation, _
      "ブックマーク" & " " & "飛び越し処理"
    Exit Sub
  End If
  '
  myTitle = "MyBookmark"
  Application.DisplayStatusBar = True
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  On Error Resume Next
  myFaceId = CommandBars(myTitle).Controls(2).FaceId
  If Err.Number <> 0 Then
   myFaceId = 706
  End If
  CommandBars(myTitle).Delete
  On Error GoTo 0
  '
  Call MyBookmarkBlln(myTitle, myFaceId)
End Sub ' MyBookmark *----*----*    *----*----*    *----*----*    *----*----*

Sub MyBookmarkBlln(myTitle As String, myFaceId As Long)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem ツールバー表示処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myCmmdBar As CommandBar
  Dim myCtrlCboxItem As CommandBarControl
  Dim myCtrlBttnOrder As CommandBarControl
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Set myCmmdBar = CommandBars.Add(Name:=myTitle, Position:=msoBarTop, Temporary:=True)
  Set myCtrlCboxItem = myCmmdBar.Controls.Add(Type:=msoControlComboBox, Before:=1, Temporary:=True)
  Set myCtrlBttnOrder = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=True)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With myCtrlCboxItem
    .DescriptionText = "ブックマークを選択選択します。"
    .Style = msoComboNormal
    .Caption = "ブックマーク選択"
    .ListIndex = 0
    .TooltipText = "ブックマークを選択して下さい。"
    .DropDownWidth = 300
    .OnAction = "MyBookmarkCboxItem"
  End With
  '
  With myCtrlBttnOrder
    .DescriptionText = "ブックマークの並び順を指定します。"
    .Style = msoButtonIcon
    .Caption = "ブックマークの並び順"
    .TooltipText = "挿入順に ブックマークを表示"
    If myFaceId = 706 Then
      .FaceId = 706
      .TooltipText = "挿入順に ブックマークを表示"
    Else
      .FaceId = 210
      .TooltipText = "名前順に ブックマークを表示"
    End If
    .OnAction = "MyBookmarkBttnOrder"
  End With
  '
  myCmmdBar.Visible = True
  Call MyBookmarkBttn(myTitle)
End Sub ' MyBookmarkBlln *----*----*    *----*----*    *----*----*    *----*----*

Sub MyBookmarkCboxItem(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [ブックマーク選択]コンボボックス処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myTitle = "MyBookmark"
  With CommandBars(myTitle).Controls(1)
    .TooltipText = .Text
  End With
  '
  Call MyBookmarkBttn(myTitle)
End Sub ' MyBookmarkCboxItem *----*----*    *----*----*    *----*----*    *----*----*

Sub MyBookmarkBttnOrder(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [ブックマークの並び順]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Dim i As Long
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myTitle = "MyBookmark"
  With CommandBars(myTitle).Controls(2)
    If .FaceId = 706 Then
      .FaceId = 210
      .TooltipText = "名前順に ブックマークを表示"
    Else
      .FaceId = 706
      .TooltipText = "挿入順に ブックマークを表示"
    End If
    '
    Call MyBookmark
  End With
End Sub ' MyBookmarkBttnOrder *----*----*    *----*----*    *----*----*    *----*----*

Sub MyBookmarkBttn(myTitle As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 各ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myBttn As Long
  Dim myFaceId As Long
  Dim myText As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With CommandBars(myTitle).Controls(1)
    myText = .Text
    myBttn = .ListIndex
  End With
  With CommandBars(myTitle).Controls(2)
    myFaceId = .FaceId
  End With
  '
  Select Case myBttn
    Case 0 ' 初期処理
      Call MyBookmarkInit(myTitle, myFaceId)
      Exit Sub
  End Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
myBookmarkBttnSubEntry:
  Selection.GoTo What:=wdGoToBookmark, Name:=myText
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
myBookmarkBttnSubExit:
  If Tasks.Exists(Name:="Microsoft Word") = True Then
    Tasks("Microsoft Word").Activate
  End If
  '
  Application.StatusBar = myTitle & "：" & "[ " & myText & " ]" & "へ飛び越ししました。"
End Sub ' MyBookmarkBttn *----*----*    *----*----*    *----*----*    *----*----*

Sub MyBookmarkInit(myTitle As String, myFaceId As Long)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 初期処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myStartMarker As Word.Range
  Dim i As Long
  Dim v As Variant
  Dim c As Long
  Dim myMax As Long
  Dim myStatusBar As String
  Dim myVerticalPercent As Long
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myMax = ActiveDocument.Bookmarks.Count
  myStatusBar = myTitle & "：ブックマーク取り込み中…"
  '
  If CommandBars(myTitle).Controls(2).FaceId <> 706 Then
    Rem 名前順
    i = 0
    ActiveDocument.Bookmarks.DefaultSorting = wdSortByName
    For Each v In ActiveDocument.Bookmarks
      i = i + 1
      CommandBars(myTitle).Controls(1).AddItem v.Name, i
      '
      c = i * 100 \ myMax
      Application.StatusBar = myStatusBar & " " & Format(c, "##0") & "%"
    Next v
    CommandBars(myTitle).Controls(1).DropDownLines = i
    myStatusBar = myTitle & "：ブックマーク取り込み完了！"
    Application.StatusBar = myStatusBar & "（名前順）"
    Exit Sub
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 挿入順。
  Application.ScreenUpdating = False
  Set myStartMarker = Selection.Range
  myVerticalPercent = ActiveDocument.ActiveWindow.VerticalPercentScrolled
  Rem ActiveDocument.Bookmarks.DefaultSorting = wdSortByLocation
  Selection.EndKey Unit:=wdStory, Extend:=wdMove
  i = 0
  For Each v In ActiveDocument.Content.Bookmarks
    i = i + 1
    ActiveDocument.Content.Bookmarks(i).Select
    CommandBars(myTitle).Controls(1).AddItem v.Name, i
    Selection.MoveLeft
    '
    c = i * 100 \ myMax
    Application.StatusBar = myStatusBar & " " & Format(c, "##0") & "%"
  Next v
  CommandBars(myTitle).Controls(1).DropDownLines = i
  myStartMarker.Select
  ActiveDocument.ActiveWindow.VerticalPercentScrolled = myVerticalPercent
  Application.ScreenUpdating = True
  '
  myStatusBar = myTitle & "：ブックマーク取り込み完了！"
  Application.StatusBar = myStatusBar & "（挿入順）"
End Sub ' MyBookmarkInit *----*----*    *----*----*    *----*----*    *----*----*