Question

我有一个电子表格，用户可以输入调查数据，并且像许多其他人一样，需要阻止用户覆盖各种格式化功能。我使用了以下内容：

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或右键单击并选择粘贴。

然而，在测试过程中发现，如果您剪切或复制一个对象（形状，插入的图片等），那么在第一次鼠标点击后它将继续粘贴。它将在每次后续点击时反复粘贴而不会停止。

我在Excel 2010和2013中验证了此行为。

有人知道如何修改它以在粘贴对象时纠正奇怪的行为吗？

Answer 1

如果您只想允许粘贴值方法，只需将下面的代码放在Microsoft Excel对象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

请注意，虽然它大部分时间都可以工作，但偶尔也可能会发生，特别是外部内容包括诸如换行文本之类的功能，没有任何内容被复制。

话虽如此，保留格式的目标仍将保留，因为它会强制用户尝试粘贴为值（或按 F2 键然后 Ctrl + V ），而不是直接粘贴。

免责声明：我不会因为它在互联网上广泛使用此代码块而获得任何荣誉。

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

1 个答案: