Excel:禁用剪切，复制，但允许粘贴功能在Excel与VBA

Question

我有代码禁用Excel中的剪切，复制和粘贴功能。但我需要允许粘贴功能，能够粘贴到我的excel从其他excel(例如C3:E10)。如有任何帮助，不胜感激

Private Sub Workbook_Activate()
Application.CutCopyMode = False
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
End Sub
Private Sub Workbook_Deactivate()
Application.CellDragAndDrop = True
Application.OnKey "^c"
Application.CutCopyMode = False
End Sub
Private Sub Workbook_WindowActivate(ByVal Wn As Window)
Application.CutCopyMode = False
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
End Sub
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
Application.CellDragAndDrop = True
Application.OnKey "^c"
Application.CutCopyMode = False
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.CutCopyMode = False
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
Application.CutCopyMode = False
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Application.CutCopyMode = False
End Sub

Answer 1

若要禁用功能区上的复制和剪切功能，请使用以下行修改Excel工作簿的HTML:

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"
onLoad="rxIRibbonUI_onLoad">
<commands>
<command idMso="Cut"
getEnabled="rxshared_getEnabled"
/>
<command idMso="Copy"
getEnabled="rxshared_getEnabled"  
/>
<command idMso="Paste"
getEnabled="rxshared_getEnabled"  
/>
</commands>
</customUI>

为此，您可以使用以下两个方法之一:

1. 使用Microsoft Office程序的自定义UI编辑器。你有一个在网上有很多信息可以使用，比如在https://bettersolutions.com/vba/ribbon/custom-ui-editor.htm
2. 将Excel工作簿扩展名从*.xlsm更改为*.xlsm.zip打开这个zip文件并创建一个customUI文件夹。在其中复制acustomUI.xml文件，包含前面的行。然后返回扩展名到*.xlsm

禁用菜单和键盘快捷键中的复制和剪切，我使用http://www.vbaexpress.com/kb/getarticle.php?kb_id=373以这种方式:

复制Thisworkbook中的代码:

Option Explicit
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
grxIRibbonUI_CutCopyPaste.Invalidate
End Sub
'===================================================================================
'===================================================================================
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=373
'===================================================================================
'===================================================================================

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
Private Sub Workbook_Open()
Call ToggleCutCopyAndPaste(False)
End Sub

标准模块Module1:

'===================================================================================
'===================================================================================
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=373
'===================================================================================
'===================================================================================
Option Explicit

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

Sub CutCopyPasteDisabled()
'Inform user that the functions have been disabled
MsgBox "Sorry!  Cutting, copying and pasting have been disabled in this workbook!"
End Sub

标准RibbonModule:

'This module is responsible for managing the HTML code that
'we have created in the Workbook
Option Explicit
Public grxIRibbonUI_CutCopyPaste As IRibbonUI
Public Sub rxIRibbonUI_onLoad(ByRef ribbon As IRibbonUI)
Set grxIRibbonUI_CutCopyPaste = ribbon
End Sub
Public Sub rxshared_getEnabled(ByRef Control As IRibbonControl, ByRef returnedVal)
Select Case Control.ID
Case "Cut"
returnedVal = False
Case "Copy"
returnedVal = False
Case "Paste"
returnedVal = True
End Select

End Sub

现在你只需要保存并重新打开Excel工作簿，你会看到剪切和复制被禁用，但你可以粘贴。