Sub myJump()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 文書内飛び越し処理
  Rem 記録者:Hitrock Camellia Shinopy
  Rem 言語:Word VBA
  Rem 機能:文書の指定箇所に飛び越しする。
  Rem 注記:myJumpを起動して使用。
  Rem 第1版:2003/11/27:作成。
  Rem 第2版:2004/01/19:選択肢を変更。
  Rem 第3版:2005/06/21:モードレス化。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim blln As Balloon
  Dim bttn As Long
  Dim bllnID As Long
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 初期処理を実行させる。
  bttn = -888
  Call myJumpBttn(blln, bttn, bllnID)
End Sub ' myJump *----*----*    *----*----*    *----*----*    *----*----*

Sub myJumpBlln(myPage As Integer, myPageMax As Integer)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem バルーン表示処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim i As Integer
  Dim myTitle As String
  Dim myText As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myTitle = "myJump"
  Assistant.Visible = True
  '
  With Assistant.NewBalloon
    .Animation = msoAnimationIdle
    .BalloonType = msoBalloonTypeButtons
    .Icon = msoIconAlertQuery
    myText = "文書内" & vbCr & "飛び越し処理" & vbCr
    myText = myText & myPage & "/" & myPageMax & "頁" & vbCr
    .Heading = myText
    .Text = "選択して下さい。"
    Select Case myPage
      Case 1
        .Button = msoButtonSetNextClose
        .Labels(1).Text = "文書の先頭"
        .Labels(2).Text = "前の頁"
        .Labels(3).Text = "画面の先頭"
        .Labels(4).Text = "一画面の先頭"
        .Labels(5).Text = "行の先頭"
      Case 2
        .Button = msoButtonSetBackNextClose
        .Labels(1).Text = "直前の編集位置"
        .Labels(2).Text = ""
        .Labels(3).Text = ""
        .Labels(4).Text = ""
        .Labels(5).Text = ""
      Case 3
        .Button = msoButtonSetBackClose
        .Labels(1).Text = "文書の末尾"
        .Labels(2).Text = "次の頁"
        .Labels(3).Text = "画面の末尾"
        .Labels(4).Text = "一画面の末尾"
        .Labels(5).Text = "行の末尾"
    End Select
    .Mode = msoModeModeless
    .Callback = "myJumpBttn"
    .Show
  End With
End Sub ' myJumpBlln *----*----*    *----*----*    *----*----*    *----*----*

Sub myJumpBttn(blln As Balloon, bttn As Long, bllnID As Long)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 各ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Dim myText As String
  Static myPage As Integer
  Static myPageMax As Integer
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myTitle = "myJump"
  '
  Select Case bttn
    Case msoBalloonButtonClose
      blln.Close
      Assistant.Visible = False
      Exit Sub
    Case msoBalloonButtonNext
      blln.Close
      myPage = myPage + 1
      Assistant.Visible = False
      Call myJumpBlln(myPage, myPageMax)
      GoTo myJumpBttnSubExit
    Case msoBalloonButtonBack
      blln.Close
      myPage = myPage - 1
      Assistant.Visible = False
      Call myJumpBlln(myPage, myPageMax)
      GoTo myJumpBttnSubExit
    Case -888 ' 初期処理
      If myPageMax = 0 Then
        myPage = 1
        myPageMax = 3
      End If
      Call myJumpBlln(myPage, myPageMax)
      Exit Sub
  End Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
myJumpBttnSubEntry:
  If myPage = 1 Then
    Select Case bttn
      Case 1
        Selection.HomeKey Unit:=wdStory
      Case 2
        With Application.Browser
          .Target = wdBrowsePage
          .Previous
        End With
      Case 3
        Selection.MoveUp Unit:=wdWindow
      Case 4
        Selection.MoveUp Unit:=wdScreen
      Case 5
        Selection.HomeKey Unit:=wdLine
    End Select
    GoTo myJumpBttnSubExit
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If myPage = 2 Then
    Select Case bttn
      Case 1
        Application.GoBack
      Case Else
        Rem
    End Select
    GoTo myJumpBttnSubExit
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If myPage = 3 Then
    Select Case bttn
      Case 1
        Selection.EndKey Unit:=wdStory
      Case 2
        With Application.Browser
          .Target = wdBrowsePage
          .Next
        End With
      Case 3
        Selection.MoveDown Unit:=wdWindow
      Case 4
        Selection.MoveDown Unit:=wdScreen
      Case 5
        Selection.EndKey Unit:=wdLine
    End Select
    GoTo myJumpBttnSubExit
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
myJumpBttnSubExit:
  If Tasks.Exists(Name:="Microsoft Word") = True Then
    Tasks("Microsoft Word").Activate
  End If
  '
  With Assistant
    Rem 次のボタン押下に備える。
    .Visible = True
    .Animation = msoAnimationCharacterSuccessMajor
  End With
  '
  Select Case bttn
    Case 1 To 5
      myText = blln.Labels.Item(bttn).Text
      Application.StatusBar = myTitle & ":" & "[ " & myText & " ]" & "へ、飛び越ししました。"
    Case msoBalloonButtonBack
      Application.StatusBar = myTitle & ":" & myPage & "/" & myPageMax & "頁へ戻りました。"
    Case msoBalloonButtonNext
      Application.StatusBar = myTitle & ":" & myPage & "/" & myPageMax & "頁へ進みました。"
  End Select
End Sub ' myJumpBttn *----*----*    *----*----*    *----*----*    *----*----*
inserted by FC2 system