تعديل كود لمنع النسخ واللصق ليشمل قائمة home

[اسلام سيد]

السلام عليكم ورحمة الله وبركاته

 

هذة اكواد تم اقتناؤها من هذا المنتدى القيم

 

1- اريد تعديلها لتشمل قائمة home حيث تقوم بمنع خاصية النسخ والقطع واللصق من خلال الماوس فقط (كليك يمين)

 

2-اريد كود لتفعيل الماكرو ليتم بصورة اوتماكية

 

جزاكم الله خيرا وبارك فيكم

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

Option Explicit

Sub ToggleCutCopyAndPaste(Allow As Boolean)
'Activate/deactivate cut, copy, paste and pastespecial menu items
    Call EnableMenuItem(21, Allow)    ' cut
    Call EnableMenuItem(19, Allow)    ' copy
    Call EnableMenuItem(22, Allow)    ' paste
    Call EnableMenuItem(755, Allow)   ' pastespecial

'Activate/deactivate drag and drop ability
    Application.CellDragAndDrop = Allow

'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
    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)
     'Activate/Deactivate specific menu item
    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()
'Inform user that the functions have been disabled
    MsgBox "Sorry!  Cutting, copying and pasting have been disabled in this workbook!"
End Sub

تم تعديل ديسمبر 5, 2013 بواسطه إسلام الشيمي

[اسلام سيد]

للرفع ، رفع الله قدركم  .

[اسلام سيد]

للرفع ، جزاكم الله خيرا

[اسلام سيد]

للرفع