| |
分かりました。では先の右クリックイベントを改造して、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
シート上のセルをどこでも右クリックすれば、そこへドロップダウンが出てきます。
|
|
