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 *----*----* *----*----* *----*----* *----*----*