2017-04-18 61 views
1

我需要你的帮助; 我有这两个代码: 首先是要禁用复制过去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的代码,我有错误消息:“检测到模糊名称”

任何想法请!

+1

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

回答

1

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。在那里的视图不是为了防止粘贴操作,而是为了防止粘贴操作搞乱图纸格式。这是一个非常有趣的部分,很好的解释和易于实现。

+0

谢谢@Variatus,这非常有帮助! –

0

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

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

+0

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

+0

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