VBA禁用复制粘贴

我需要你的帮助; 我有这两个代码：首先是要禁用复制过去VBA禁用复制粘贴

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

二是启用复制过去的宏宏：

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

当我EXCUTE的代码，我有错误消息：“检测到模糊名称”

任何想法请！

来源

2017-04-18 Houcine Adsens

您有两个'Workbook_SheetSelectionChange'子例程。因此子程序名称是不明确的。 – YowE3K

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

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

该代码改编自code published here。在那里的视图不是为了防止粘贴操作，而是为了防止粘贴操作搞乱图纸格式。这是一个非常有趣的部分，很好的解释和易于实现。

来源

2017-04-18 10:19:05 Variatus

谢谢@Variatus，这非常有帮助！ –

你得到了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)

来源

2017-04-18 08:58:55

你好@David G先生，我没有更多的错误信息，但第二个（启用复制）不起作用:) –

对不起，不得不投票，因为'Workbook_SheetSelectionChange'是一个工作表事件，并且当你从一个单元格移动到另一个单元格时触发在工作表中，“Workbook_SheetSelectionChangeEnable”只是一个过程名称，不会触发 - 导致OP在其评论中出现的问题。 –

@Darren：“Workbook_SheetSelectionChange”是一个自定义的子集，并且不能有2个具有相同名称的子集，因此他的错误消息为“检测到不明确的名称”。我没有看到任何降低投票的理由，请向我解释我的错误 –

VBA禁用复制粘贴

回答

相关问题