使用Application.OnKey与Workbook_Activate禁用剪切复制粘贴的跨工作簿问题

问题背景 #

• 需求：仅对指定工作簿禁用Ctrl+X（剪切）、Ctrl+C（复制）、Ctrl+V（粘贴），以及右键菜单对应的功能
• 现有问题：网上找到的VBA代码生效但会锁定所有打开的工作簿；添加工作簿名称判断后逻辑仍无效
• 编译错误：参考方案时出现 Compile error: Procedure declaration does not match description of event or procedure having the same name

用户尝试的代码片段 #

初始禁用代码

Private Sub DisableXCV()
With Application
.OnKey "^x", ""
.OnKey "^c", ""
.OnKey "^v", ""
.CommandBars("Cell").Controls(1).Enabled = False
.CommandBars("Cell").Controls(2).Enabled = False
.CommandBars("Cell").Controls(3).Enabled = False
End With
End Sub

添加工作簿判断后的代码

Private Sub DisableXCV()
If ActiveWorkbook.Name = "insert workbookname here" Then
With Application
.OnKey "^x", ""
.OnKey "^c", ""
.OnKey "^v", ""
.CommandBars("Cell").Controls(1).Enabled = False
.CommandBars("Cell").Controls(2).Enabled = False
.CommandBars("Cell").Controls(3).Enabled = False
End With
End If
End Sub

触发编译错误的代码

Private Sub Workbook_Activate(ByVal sh As Object)
If sh.Name = "System Checks" Then
    Application.OnKey "^{x}", ""
    Application.OnKey "^{c}", ""
    Application.OnKey "^{v}", ""
    Application.CommandBars("Cell").Controls(1).Enabled = False
    Application.CommandBars("Cell").Controls(2).Enabled = False
    Application.CommandBars("Cell").Controls(3).Enabled = False
Else
    Application.OnKey "^{x}"
    Application.OnKey "^{c}"
    Application.OnKey "^{v}"
    Application.CommandBars("Cell").Controls(1).Enabled = True
    Application.CommandBars("Cell").Controls(2).Enabled = True
    Application.CommandBars("Cell").Controls(3).Enabled = True
End If
End Sub

Private Sub Workbook_Deactivate()
    Application.OnKey "^{x}"
    Application.OnKey "^{c}"
    Application.OnKey "^{v}"
    Application.CommandBars("Cell").Controls(1).Enabled = True
    Application.CommandBars("Cell").Controls(2).Enabled = True
    Application.CommandBars("Cell").Controls(3).Enabled = True
End Sub

问题分析 #

1. 编译错误原因：Workbook_Activate是Excel内置事件，无参数，用户错误添加了ByVal sh As Object参数，导致与系统默认的事件声明不匹配。
2. 全局锁定原因：Application.OnKey和CommandBars是全局设置，若未绑定工作簿的激活/失活事件，执行后会影响所有打开的工作簿；之前的自定义过程仅手动执行时生效，无法自动响应工作簿切换。
3. 控件索引不可靠：直接用Controls(1)/Controls(2)判断右键菜单，不同Office版本或语言环境下，控件顺序可能变化，导致判断失效。

解决方案 #

将以下代码粘贴到目标工作簿的ThisWorkbook模块中：

Private Sub Workbook_Activate()
    ' 禁用当前工作簿的剪切/复制/粘贴快捷键
    With Application
        .OnKey "^x", ""
        .OnKey "^c", ""
        .OnKey "^v", ""
        
        ' 禁用右键菜单的剪切、复制、粘贴（按标题判断，兼容多语言/版本）
        Dim ctrl As CommandBarControl
        For Each ctrl In .CommandBars("Cell").Controls
            Select Case ctrl.Caption
                Case "剪切(&T)", "Cut(&T)"
                    ctrl.Enabled = False
                Case "复制(&C)", "Copy(&C)"
                    ctrl.Enabled = False
                Case "粘贴(&P)", "Paste(&P)"
                    ctrl.Enabled = False
            End Select
        Next ctrl
    End With
End Sub

Private Sub Workbook_Deactivate()
    ' 恢复全局的剪切/复制/粘贴快捷键
    With Application
        .OnKey "^x"
        .OnKey "^c"
        .OnKey "^v"
        
        ' 恢复右键菜单功能
        Dim ctrl As CommandBarControl
        For Each ctrl In .CommandBars("Cell").Controls
            Select Case ctrl.Caption
                Case "剪切(&T)", "Cut(&T)"
                    ctrl.Enabled = True
                Case "复制(&C)", "Copy(&C)"
                    ctrl.Enabled = True
                Case "粘贴(&P)", "Paste(&P)"
                    ctrl.Enabled = True
            End Select
        Next ctrl
    End With
End Sub

关键说明 #

• 代码绑定Workbook_Activate/Workbook_Deactivate事件，切换到目标工作簿时自动禁用，切出时自动恢复，不会影响其他文件。
• 用控件标题（Caption）判断右键菜单项，避免因版本/语言差异导致的索引失效问题。
• 确保代码放在目标工作簿的ThisWorkbook模块中，而非普通模块。

内容的提问来源于stack exchange，提问作者Fermion