VBA禁用复制粘贴

我需要你的帮助， 我有这两个代码：第一个是禁用复制过去的macros

Sub Desable_Copy() Dim oCtrl As Office.CommandBarControl For Each oCtrl In Application.CommandBars.FindControls(ID:=21) oCtrl.Enabled = False Next oCtrl For Each oCtrl In Application.CommandBars.FindControls(ID:=19) oCtrl.Enabled = False Next oCtrl Application.CellDragAndDrop = False End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) With Application .CellDragAndDrop = False .CutCopyMode = False 'Clear clipboard End With End Sub 

第二个是启用复制过去的macros：

 Sub Enable_Copy() Dim oCtrl As Office.CommandBarControl For Each oCtrl In Application.CommandBars.FindControls(ID:=21) oCtrl.Enabled = True Next oCtrl For Each oCtrl In Application.CommandBars.FindControls(ID:=19) oCtrl.Enabled = True Next oCtrl Application.CellDragAndDrop = True End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) With Application .CellDragAndDrop = True .CutCopyMode = True 'Clear clipboard End With End Sub 

当我执行代码时，我有一个错误消息：“检测到不明确的名称”

任何想法请！

Answer 1

Excel的复制/粘贴function是为Excel应用程序设置的。 如果您为一个工作簿禁用它们，则会禁用它们。 如果您同时打开多个工作簿，那么pipe理变得相当麻烦 – 如果您是专家程序员，或许您不是。 考虑替代方法，比如Application.Undo ，它可以在Worksheet_Change事件上运行。 下面的代码将撤消工作表上的任何粘贴操作。

 Private Sub Worksheet_Change(ByVal Target As Range) ' 18 Apr 2017 Dim UndoList As String With Application .EnableEvents = False .ScreenUpdating = False End With On Error GoTo ErrExit UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1) If Left(UndoList, 5) = "Paste" Or UndoList = "Auto Fill" Then MsgBox "Please don't paste values on this sheet." & vbCr & _ "The action will be reversed.", vbInformation, _ "Paste is not permitted" With Application .Undo .CutCopyMode = False End With Target.Select End If ErrExit: With Application .ScreenUpdating = True .EnableEvents = True End With End Sub 

此代码是根据此处发布的代码进行调整的 这里的视图不是为了防止粘贴操作，而是为了防止粘贴操作搞乱图纸格式。 这是一个非常有趣的作品，很好的解释和易于实施。

Answer 2

你有两个私人的同名子。

例如，您可以更改第二个：

 Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 

至

 Private Sub Workbook_SheetSelectionChangeEnable(ByVal Sh As Object, ByVal Target As Range)