Disable right click for copy cut paste only

[YasserKhalil]

Hello everyone
Is there a way to disable Copy Cut Paste only from Right Click menu in a workbook ..
Just these commands only
Thanks advanced for help

 

[Villalobos]

Hi,

See if it is help for you.

ThisWorkbook:

Option Explicit
Private Sub Workbook_Activate()
    Call ToggleCutCopyAndPaste(False)
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call ToggleCutCopyAndPaste(True)
End Sub
Private Sub Workbook_Deactivate()
    Call ToggleCutCopyAndPaste(True)
End Sub
Private Sub Workbook_Open()
    Call ToggleCutCopyAndPaste(False)
End Sub

Module1:

Option Explicit
Sub ToggleCutCopyAndPaste(Allow As Boolean)
    Call EnableMenuItem(21, Allow)
    Call EnableMenuItem(19, Allow)
    Call EnableMenuItem(22, Allow)
    Call EnableMenuItem(755, Allow)

    Application.CellDragAndDrop = Allow

    With Application
        Select Case Allow
            Case Is = False
                .OnKey "^c", "CutCopyPasteDisabled"
                .OnKey "^v", "CutCopyPasteDisabled"
                .OnKey "^x", "CutCopyPasteDisabled"
                .OnKey "+{DEL}", "CutCopyPasteDisabled"
                .OnKey "^{INSERT}", "CutCopyPasteDisabled"
            Case Is = True
                .OnKey "^c"
                .OnKey "^v"
                .OnKey "^x"
                .OnKey "+{DEL}"
                .OnKey "^{INSERT}"
            End Select
    End With
End Sub
Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)
    Dim cBar As CommandBar
    Dim cBarCtrl As CommandBarControl
    For Each cBar In Application.CommandBars
        If cBar.Name <> "Clipboard" Then
            Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
            If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
        End If
    Next
End Sub
Sub CutCopyPasteDisabled()
End Sub

 

[YasserKhalil]

Thanks for reply
That's great
It is now disabled in right click but I need to allow the shortcut keys Ctrl + C / Ctrl + X / Ctrl + V
Thanks a lot for help

 

[Villalobos]

this enable the keys

Sub Enable_Keys()
Dim StartKeyCombination As Variant
Dim KeysArray As Variant
Dim Key As Variant
Dim I As Long

    On Error Resume Next

    For Each StartKeyCombination In Array("+", "^", "%", "+^", "+%", "^%", "+^%")

        KeysArray = Array("{BS}", "{BREAK}", "{CAPSLOCK}", "{CLEAR}", "{DEL}", _
                    "{DOWN}", "{END}", "{ENTER}", "~", "{ESC}", "{HELP}", "{HOME}", _
                    "{INSERT}", "{LEFT}", "{NUMLOCK}", "{PGDN}", "{PGUP}", _
                    "{RETURN}", "{RIGHT}", "{SCROLLLOCK}", "{TAB}", "{UP}")

        For Each Key In KeysArray
            Application.OnKey StartKeyCombination & Key
        Next Key

        For I = 0 To 255
            Application.OnKey StartKeyCombination & Chr$(I)
        Next I

        For I = 1 To 15
            Application.OnKey StartKeyCombination & "{F" & I & "}"
        Next I

    Next StartKeyCombination

    For I = 1 To 15
        Application.OnKey "{F" & I & "}"
    Next I

    Application.OnKey "{PGDN}"
    Application.OnKey "{PGUP}"
End Sub

 

[YasserKhalil]

Thanks a lot for this great help
I have to run the last procedure to be able to use keys
Thanks for this wonderful help