Search code examples
excelvbacopy-paste

Disable Copy/Paste to Excel from other sources


I want to disable the copy/paste function so people cannot paste anything over a workbook I created.

Using the below code, I succeeded in preventing people from copying from another workbook to this one or vice versa.

However, they can still copy from other non-Excel sources, such as Outlook or an internet browser. If it doesn't come from excel, it can be pasted into this workbook. How do I prevent this so that no pasting can occur in the workbook whatsoever?

Code in Module:

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", ""
                .OnKey "^v", ""
                .OnKey "^x", ""
                .OnKey "^{DEL}", ""
                .OnKey "^{INSERT}", ""
            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

Code in ThisWorkbook:

Private Sub Workbook_Open()
Call ToggleCutCopyAndPaste(False)
End Sub

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

Solution

  • I've found another method that disables people being able to paste into the workbook from Outlook, an internet browser, etc. No module needed. Just drop the below code in ThisWorkbook:

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.CutCopyMode = True
    Application.OnKey "^c"
    Application.OnKey "^v"
    Application.OnKey "^{INSERT}",
    Application.OnKey "^{DELETE}",
    Application.CommandBars("Cell").Enabled = True
    Application.CellDragAndDrop = True
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
    End Sub
    
    Private Sub Workbook_Open()
    Application.CutCopyMode = False
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "^{INSERT}", ""
    Application.OnKey "^{DELETE}", ""
    Application.CommandBars("Cell").Enabled = False
    Application.CellDragAndDrop = False
    'use if statement here if you want to situationally keep ribbon
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
    'Else
    'Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
    'End If
    End Sub
    
    Private Sub Workbook_Activate()
    Application.CutCopyMode = False
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "^{INSERT}", ""
    Application.OnKey "^{DELETE}", ""
    Application.CommandBars("Cell").Enabled = False
    Application.CellDragAndDrop = False
    'use if statement here if you want to situationally keep ribbon
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
    'Else
    'Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
    'End If
    End Sub
    
    Private Sub Workbook_Deactivate()
    Application.CellDragAndDrop = True
    Application.OnKey "^c"
    Application.OnKey "^v"
    Application.OnKey "^{INSERT}"
    Application.OnKey "^{DELETE}"
    Application.CommandBars("Cell").Enabled = True
    Application.CutCopyMode = True
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
    End Sub
    
    Private Sub Workbook_WindowActivate(ByVal Wn As Window)
    Application.CutCopyMode = False
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "^{INSERT}", ""
    Application.OnKey "^{DELETE}", ""
    Application.CommandBars("Cell").Enabled = False
    Application.CellDragAndDrop = False
    End Sub
    
    Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
    Application.CellDragAndDrop = True
    Application.OnKey "^c"
    Application.OnKey "^v"
    Application.OnKey "^{INSERT}"
    Application.OnKey "^{DELETE}"
    Application.CommandBars("Cell").Enabled = True
    Application.CutCopyMode = True
    End Sub
    
    Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "^{INSERT}", ""
    Application.OnKey "^{DELETE}", ""
    Application.CommandBars("Cell").Enabled = False
    Application.CellDragAndDrop = False
    Application.CutCopyMode = False
    End Sub
    

    Note that I've disabled the ribbon as well, as it's still possible to paste using the Home tab. Frustrating that there doesn't seem to be a way to disable copy/paste completely and not just from Excel to Excel.

    If you want, you can put this code in a module and run it manually when you need to access copy/paste tools:

    Sub Enable_CopyPaste()
    
    'Run this sub when you need to access copy/paste tools
    
    Application.CutCopyMode = True
    Application.OnKey "^c"
    Application.OnKey "^v"
    Application.OnKey "^{INSERT}"
    Application.OnKey "^{DELETE}"
    Application.CommandBars("Cell").Enabled = True
    Application.CellDragAndDrop = True
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
    
    End Sub