Excel VBA代码强制值仅粘贴粘贴对象时会导致奇怪的行为

我有一个用户input调查数据的电子表格，并且像许多人一样，需要防止用户覆盖各种格式化function。 我使用了以下内容：

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) On Error Resume Next Target.PasteSpecial xlPasteValues Application.CutCopyMode = True End Sub 

该代码非常适合强制值复制或剪切单元格后粘贴。 当您剪切或复制时，您点击的下一个单元格会收到粘贴，您不必使用Ctrl + V或右键单击并select粘贴。

但是，在testing过程中发现，如果您剪切或复制一个对象（形状，插入的图片等），那么在第一次鼠标点击之后，它将继续粘贴。 它会一次又一次粘贴，随后的每次点击都不停止。

我在Excel 2010和2013中validation了这一行为。

有谁知道如何修改这个来修正粘贴对象时的奇怪行为？

Answer 1

如果你想只允许粘贴值的方法，只需将下面的代码放在Microsoft Excel Objects ThisWorkbook （即不在任何模块下）。

 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim UndoString As String, srce As Range On Error GoTo err_handler UndoString = Application.CommandBars("Standard").Controls("&Undo").List(1) If Left(UndoString, 5) <> "Paste" And UndoString <> "Auto Fill" Then Exit Sub End If Application.ScreenUpdating = False Application.EnableEvents = False Application.Undo If UndoString = "Auto Fill" Then Set srce = Selection srce.Copy Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.SendKeys "{ESC}" Union(Target, srce).Select Else Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End If Application.ScreenUpdating = True Application.EnableEvents = True Exit Sub err_handler: Application.ScreenUpdating = True Application.EnableEvents = True End Sub 

请注意，尽pipe它大部分时间都可以使用，但偶尔也会发生这种情况，特别是对于包含包装文本等function的外部内容，不会有任何内容被复制。

这就是说，保持格式的目的仍然会保持，因为它会强制用户尝试粘贴值（或按F2键，然后Ctrl + V ），而不是直接粘贴。

免责声明：我不认为这个代码块，因为它是在互联网上广泛可用。