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禁用複製粘貼

回答

相關問題