EXCEL2010禁用复制粘贴功能VBA代码分享

wb169646

大家好！
前两天在中文网站寻找EXCEL2010禁用复制粘贴功能的代码，找了好长时间，所找到的那些代码都是只能用于2003而无法用于2010的，最后不得以用Google在英文网站搜，终于找到了这段代码，现分享出来供大家所用。

'*** In a standard module ***
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

'*** In the ThisWorkbook Module ***
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

f8b1987

{:soso_e144:}
EXCEL 2010禁用宏就没效果了

研究研究

{:soso_e102:}  正在查这方面的信息
谢谢楼主了

aqlal

谢谢楼主,很有用的代码！

有个问题，这段代码不但屏蔽掉复制单元格的全部（格式、有效性等），把复制单元格内的内容也屏蔽了， 把这句屏蔽掉：Call EnableMenuItem(21, Allow) ' cut
可以出现复制选项，但是双击单元格后选中单元格内的内容时，右键还是不能出现“复制”。
实际上大家采用这段代码多数是为了防止格式、数据有效性等被随意复制、粘贴，并不是针对内容的，因此还望楼主和老师们能提供允许复制粘贴内容的相关代码。

cc15923373067

禁用过后又如何启用呢

mrhejin

楼主您好！我复制进去后运行宏，提示编译错误，请问应该怎样操作才可以在2007中禁止粘贴啊？谢谢！

huazai688

但在开始菜单下的剪切和复制功能没有屏蔽

天堑小舟

当设置保护工作表时，禁止复制。如何实现呢。

Ahiols

huazai688 发表于 2014-1-2 11:17
但在开始菜单下的剪切和复制功能没有屏蔽

菜单下的剪切和复制功能没有屏蔽，你解决木有。找不到相应的参数

whx20747

正需要这个,谢谢楼主的分享先了, 学习了,给楼主多个赞