Excel VBA：Target Intersect防粘贴失效及禁用所有粘贴功能的需求

我懂你遇到的痛点——之前用Worksheet_Change结合Intersect检查粘贴行为，结果PasteSpecial直接绕开了数据验证，完全没触发你的检查逻辑。要把所有粘贴途径都堵上，得从快捷键、右键菜单、工具栏按钮、直接PasteSpecial调用这几个维度同时下手，下面是完整的解决方案：

步骤1：在目标工作表模块中添加代码 #

打开你的Excel文件，按Alt+F11进入VBA编辑器，找到你要保护的工作表（比如Sheet1），双击打开它的代码窗口，粘贴以下代码：

Option Explicit

' 禁用Ctrl+V快捷键（仅在选中目标区域时生效）
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("I14:J1000")) Is Nothing Then
        Application.OnKey "^v", "" ' 清空Ctrl+V的默认执行行为
    Else
        Application.OnKey "^v" ' 离开目标区域后恢复正常粘贴
    End If
End Sub

' 拦截右键菜单的粘贴选项
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Me.Range("I14:J1000")) Is Nothing Then
        ' 遍历右键菜单，隐藏所有含"Paste"的选项
        Dim cmdCtrl As CommandBarControl
        For Each cmdCtrl In Application.CommandBars("Cell").Controls
            If cmdCtrl.Caption Like "*Paste*" Then
                cmdCtrl.Visible = False
            End If
        Next cmdCtrl
    Else
        ' 非目标区域，恢复右键粘贴选项
        Dim cmdCtrl2 As CommandBarControl
        For Each cmdCtrl2 In Application.CommandBars("Cell").Controls
            If cmdCtrl2.Caption Like "*Paste*" Then
                cmdCtrl2.Visible = True
            End If
        Next cmdCtrl2
    End If
End Sub

' 兜底检查：拦截所有已完成的粘贴操作（含PasteSpecial）
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim affectedArea As Range
    Set affectedArea = Intersect(Target, Me.Range("I14:J1000"))
    
    If Not affectedArea Is Nothing Then
        On Error GoTo Cleanup
        Application.EnableEvents = False ' 防止循环触发事件
        
        ' 获取撤销历史，判断是否为粘贴类操作
        Dim undoAction As String
        On Error Resume Next
        undoAction = Application.CommandBars("Standard").Controls("&Undo").List(1)
        On Error GoTo Cleanup
        
        If Left(undoAction, 5) = "Paste" Or Left(undoAction, 12) = "Paste Special" Then
            MsgBox "该区域禁止粘贴操作！", vbExclamation, "操作提示"
            Application.Undo ' 直接撤销粘贴行为
        End If
    End If
    
Cleanup:
    Application.EnableEvents = True
End Sub

步骤2：添加全局工具栏粘贴按钮拦截（可选） #

如果还要禁用顶部工具栏的粘贴按钮，需要在ThisWorkbook模块中添加以下代码，确保打开工作簿时就生效：

Option Explicit

Private Sub Workbook_Open()
    ' 禁用标准工具栏的粘贴按钮
    Application.CommandBars("Standard").Controls("Paste").Enabled = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' 关闭工作簿时恢复工具栏粘贴按钮，避免影响其他文件
    Application.CommandBars("Standard").Controls("Paste").Enabled = True
End Sub

代码逻辑说明 #

• Worksheet_SelectionChange：精准控制快捷键，只有选中目标区域时才禁用Ctrl+V，不影响其他区域的正常操作。
• Worksheet_BeforeRightClick：动态隐藏/显示右键菜单的粘贴选项，从入口就堵死右键粘贴的可能。
• Worksheet_Change：作为最后一道防线，不管用户用什么特殊方式完成粘贴，只要触发单元格变更，就通过撤销历史判断并回滚操作。
• 全局工具栏拦截：防止用户点击顶部工具栏的粘贴按钮，关闭工作簿时自动恢复，避免影响其他Excel文件的使用。

这套组合拳下来，就能彻底把所有粘贴方式（包括PasteSpecial）都拦截在指定区域外了。

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