Отключить копирование / вставку в Excel из других источников

Question

Я хочу отключить функцию копирования / вставки, чтобы люди не могли ничего вставлять в созданную мной рабочую книгу.

Используя приведенный ниже код, мне удалось предотвратить копирование людьми из другой рабочей книги в эту или наоборот..

Однако их можно копировать из других источников, не относящихся к Excel, таких как Outlook или интернет-браузер.Если он не из Excel, его можно вставить в эту книгу.Как предотвратить это, чтобы в рабочей книге вообще не было вставки?

Код в модуле:

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

Код в этой рабочей книге:

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

Answer 1

Я нашел другой метод, который запрещает людям вставлять в рабочую книгу из Outlook, интернет-браузера и т. Д. Модуль не требуется.Просто поместите приведенный ниже код в 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

Обратите внимание, что я также отключил ленту, так как все еще можно вставлять с помощью вкладки "Главная".Расстраивает, что не существует способа полностью отключить копирование / вставку, а не только из Excel в Excel.

Если вы хотите, вы можете поместить этот код в модуль и запускать его вручную, когда вам нужночтобы получить доступ к инструментам копирования / вставки:

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

Answer 2

Спасибо CLR за указание на активацию окна.Я добавил это в ThisWorkbook:

Private Sub Workbook_Deactivate()
    Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
    Call ToggleCutCopyAndPaste(False)
End Sub

Хотя изначально это не помогло решить проблему, это было сделано в сочетании с этим кодом, добавленным в Модуль:

Dim oData   As New DataObject 'object to use the clipboard

    oData.SetText Text:=Empty 'Clear
    oData.PutInClipboard 'take in the clipboard to empty it

Теперь пользователи могут 'сместить и переформатировать содержимое книги с помощью копирования / вставки из Outlook, интернет-браузеров и т. д.