[[20150124131724]]　『複数の「指定シート以外」を右クリック禁止にする』（まさ）　ページの最後に飛ぶ

『複数の「指定シート以外」を右クリック禁止にする方法について』（まさ）

いつも大変おせわになっております。
右クリックメニューについてアドバイスをよろしくお願いします。

質問内容は

指定シート（複数）以外は右クリックメニューを非表示（禁止）にする方法についてです。

よろしくお願いします。

下記コードは、ThisWorkbookに記載しているコードです。
処理内容は、シート名「1」以外は、右クリック禁止にします。

これを、シート名「1～31」以外を右クリック禁止にしたいと考えております。

※シート名「1～31」とは、半角数字で31枚シートがあります。

'指定シート以外右クリック禁止
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

　　If Sh.Name <> "1" Then　'指定シート名「1」以外のシートは右クリック禁止

        MsgBox "右クリック禁止!!", vbExclamation

        Cancel = True

    End If

End Sub

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 もし、シート　25 の他に　シート 25ABC といったものがなければ

'指定シート以外右クリック禁止
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

    Dim z As Long

    z = Val(Sh.Name)

    If z < 1 Or z > 31 Then     'シート名「1」～「31」以外のシートは右クリック禁止

        MsgBox "右クリック禁止!!", vbExclamation
        Cancel = True

    End If

End Sub

（β） 2015/01/24(土) 15:26

こんなのでも

 Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim i As Long
    Dim s As String

    For i = 1 To 31
        s = s & i & "\"
    Next

    If InStr(s, Sh.Name) = 0 Then
        MsgBox "右クリック禁止!!", vbExclamation
        Cancel = True
    End If

 End Sub

（マナ） 2015/01/24(土) 15:37

βさん
マナさん

ありがとうございます。
どちらもバッチリ動きました。

もう一つお願いします。
同じように右クリックの処理なのですが、下記は、指定範囲内に右クリック処理を追加するコードの一部なのですが

これに、教えていただいたコードを組み込見たいと考えております。

組み込んだ場合・・・

シート「１～３１」のセル範囲「a1:a10,c1:c10」以外は右クリック禁止となるのでしょうか？
　　　↓

If Intersect(Target, Range("a1:a10,c1:c10")) Is Nothing Then Exit Sub

お忙しい中すみませんが、よろしくお願いします。

（まさ） 2015/01/24(土) 16:01

 たとえば

 '指定シート以外右クリック禁止
 Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim z As Long
    Dim ok As Boolean

    z = Val(Sh.Name)

    Select Case z
        Case 1 To 31
            If Not Intersect(Target, Sh.Range("A1:A10,C1:C10")) Is Nothing Then ok = True
    End Select

    If Not ok Then     'シート名「1」～「31」の A1:A10,C1:C10 以外は右クリック禁止

        MsgBox "右クリック禁止!!", vbExclamation
        Cancel = True

    End If

 End Sub

（β） 2015/01/24(土) 16:30

βさんありがとうございます。

試してみました。

相談なのですが、右クリック可能セル範囲で、マクロ処理を追加しようとしたのですが

マクロ処理実行されて・・・その後に「右クリック禁止」とでます。

下記のコード「*****」部分が処理の位置です。

アドバイスの程よろしくお願いします。

 '指定シート以外右クリック禁止
 Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

    Dim z As Long
    Dim ok As Boolean
    z = Val(Sh.Name)

    Select Case z
        Case 1 To 31
            If Not Intersect(Target, Sh.Range("A1:A10,C1:C10")) Is Nothing Then ok = True

'**********************　

　　<<処理>>

　　End Select

'**********************

    If Not ok Then     'シート名「1」～「31」の A1:A10,C1:C10 以外は右クリック禁止
        MsgBox "右クリック禁止!!", vbExclamation
        Cancel = True
    End If
 End Sub
（まさ） 2015/01/24(土) 17:13

あっ

すみません、解決出来ました。
勘違いでした。

バッチリ動作中です。
ありがとうございました(^^ゞ
（まさ） 2015/01/24(土) 17:18

解決後ですが、複数セル選択状態の場合で、どっちか迷ったので、あえて違うほうを載せておきます。

 Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim i As Long
    Dim s As String
    Dim r As Range

    For i = 1 To 31
        s = s & i & "\"
    Next

    If InStr(s, Sh.Name) > 0 Then
        Set r = Intersect(Target, Sh.Range("a1:a10,c1:c10"))
        If Not r Is Nothing Then
            If r.Count = Target.Count Then Exit Sub
        End If
    End If

    MsgBox "右クリック禁止!!", vbExclamation
    Cancel = True

 End Sub

（マナ） 2015/01/24(土) 17:26

コメント返信：

[ 一覧(最新更新順) ]

[[20150124131724]] 『複数の「指定シート以外」を右クリック禁止にする』（まさ） ページの最後に飛ぶ

[[20150124131724]]　『複数の「指定シート以外」を右クリック禁止にする』（まさ）　ページの最後に飛ぶ