EXCEL2010禁用复制粘贴功能

*** 在标准模块中的代码 ***

Option Explicit        '选项显示方式

Sub ToggleCutCopyAndPaste(Allow As Boolean)
     '激活/禁用 cut(剪切), copy(复制), paste(粘贴) 和 pastespecial(选择性粘贴)
    Call EnableMenuItem(21, Allow)    '调用cut(剪切)
    Call EnableMenuItem(19, Allow)    '调用copy(复制)
    Call EnableMenuItem(22, Allow)    '调用paste(粘贴)
    Call EnableMenuItem(755, Allow)   '调用pastespecial(选择性粘贴)
     
     '激活/禁用拖放功能
    Application.CellDragAndDrop = Allow
     
     '激活/禁用 cut(剪切), copy(复制), paste(粘贴) 和 pastespecial(选择性粘贴)
    With Application
        Select Case Allow     '允许选择
        Case Is = False       '为假
            .OnKey "^c", "CutCopyPasteDisabled"          '"Ctrl+c"复制快捷键无效，并通知用户
            .OnKey "^v", "CutCopyPasteDisabled"          '"Ctrl+v"粘贴快捷键无效，并通知用户
            .OnKey "^x", "CutCopyPasteDisabled"          '"Ctrl+x"剪切快捷键无效，并通知用户
            .OnKey "+{DEL}", "CutCopyPasteDisabled"      '"+{DEL}"删除快捷键无效，并通知用户
            .OnKey "^{INSERT}", "CutCopyPasteDisabled"   '"Ctrl+{INSERT}"插入快捷键无效，并通知用户
        Case Is = True           '为真
            .OnKey "^c"          '"Ctrl+c"复制快捷键有效
            .OnKey "^v"          '"Ctrl+v"粘贴快捷键有效
            .OnKey "^x"          '"Ctrl+x"剪切快捷键有效
            .OnKey "+{DEL}"      '"+{DEL}"删除快捷键有效
            .OnKey "^{INSERT}"   '"Ctrl+{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()   '通知用户功能已被禁用
    MsgBox "对不起！本工作簿中已禁用剪切、复制和粘贴！"
End Sub

'*** 在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