| 
    
     |  | 分かりました。では先の右クリックイベントを改造して、Index が 4〜25までの シート名をリストにした、ドロップダウンボックスを出すようにしてみます。
 ↓これを ThisWorkbookモジュールに入れて下さい。
 
 Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, _
 ByVal Target As Range, Cancel As Boolean)
 Dim Lp As Single, Tp As Single, Wp As Single, Hp As Single
 Dim i As Integer
 
 Cancel = True: Sh.DropDowns.Delete
 With Target
 Lp = .Left: Tp = .Top: Wp = .Width * 1.5: Hp = .Height
 End With
 With Sh.DropDowns.Add(Lp, Tp, Wp, Hp)
 For i = 4 To 25
 If i <> Sh.Index Then
 .AddItem Worksheets(i).Name
 End If
 Next i
 .OnAction = "JumpS"
 End With
 End Sub
 
 そして標準モジュールに↓これを入れて下さい。
 
 Sub JumpS()
 Dim i As Integer
 
 With ActiveSheet.DropDowns(Application.Caller)
 i = .ListIndex
 If i < 1 Then Exit Sub
 .Delete
 End With
 Worksheets(i).Activate
 End Sub
 
 シート上のセルをどこでも右クリックすれば、そこへドロップダウンが出てきます。
 
 |  |