在工作簿中和从其他应用程序中无格式粘贴

Question

我已经阅读了各种关于使用 VBA 防止由于用户粘贴数据而导致电子表格格式更改的帖子。

我不喜欢将 CTRL+V 绑定到宏的方法，因为用户可能不使用快捷方式，而且有些示例具有粘贴到随后单击的任何单元格的效果。

我在https://www.mrexcel.com/board/threads/vba-for-pastespecial-values-only.355553/ 中使用撤消功能的代码取得了最大的成功。这适用于工作簿中的复制和粘贴（虽然有点慢），也适用于单个或多个单元格，但不适用于 Excel 的其他实例或其他程序。

我发现 Excel vba paste special method fails whenever i try to paste 可以将粘贴到单个单元格中。

有没有办法将两者结合起来，达到防止从任何来源粘贴更改单元格格式的目的？

Answer 1

我认为我写了一些有用的东西，似乎对我很有效。

我没有实施您的建议，因为它看起来相当复杂，我发现另一个论坛帖子的“撤消”脚本形式略有不同，适用于复制和粘贴文本或单个单元格，或者范围从在 excel 实例中或来自外部程序。我已经将它与我发现的更常见的版本相结合，它也处理“自动填充”事件，并且我添加了一些其他的小增强功能。

我已确认我也使用过的其他论坛帖子。这是以防万一它对其他人有用。我不是专家，我希望代码可以改进，但它可以满足我的需要。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    'Prevents user changing cell formatting by undoing the paste and pasting the value only without formatting
    'Macro restricted to run on paste events to prevent the pasting of formats into the spreasheet, but not run on delete or type events
    'Works with ranges and individual cells, both within the workbook Excel instance and from other instances or external programs
    'A combination of:
    'https://www.mrexcel.com/board/threads/force-paste-special-values.230718/
    'https://stackoverflow.com/questions/45135039/excel-vba-code-to-force-values-only-paste-causes-strange-behavior-when-pasting-o
    'And:
    'https://answers.microsoft.com/en-us/msoffice/forum/all/how-do-you-lock-formats-but-allow-data-entry/afccc43e-e191-417f-826c-d10a464a1b9a?page=4
    'A disadvantage of many macros, including this one, is that the undo history is cleared
    'Macro can be disabled for spreadsheet developement by changing the Devel value used in the first IF statement of the macro

    Dim Devel As Boolean
    Devel = "False" 'Remember to set back to False after spreadsheet development work
    If Devel = "False" Then
        'In normal user mode, prevent pastes etc from changing formatting
        Dim SavedVal As Variant
        Dim UndoString As String
        Dim srce As Range
        
        On Error GoTo ErrHan
        
        'Detect 'Paste' and 'Auto Fill' events in the undo list and only continue macro if these are found
        UndoString = Application.CommandBars("Standard").Controls("&Undo").List(1) 'This always gives an error on spreadsheet open as the undo list is empty, but the error handling deals with it
        If Left(UndoString, 5) <> "Paste" And UndoString <> "Auto Fill" Then
            Exit Sub
        End If
    
        'Save the pasted value for later. This form and the use of type Variant is important in the flexibility of this macro
        SavedVal = Target.Value
    
        'Switch off events to prevent infinite loop
        Application.EnableEvents = False
        
        'Switch off screen updates
        Application.ScreenUpdating = False
    
        'Undo the user's paste
        Application.Undo
        
        'Handle 'Auto Fill' events differently. These can use the Target.PasteSpecial approach
        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
            'Set target value. This form works with all selected data which the Target.PasteSpecial approaches don't
            Target.Value = SavedVal
        End If
    Else
        'In Devel mode so the developer can unlock the spreadsheet and change formats when pasting
    End If

ErrExit:
    'Remember to re-enable events
    Application.EnableEvents = True
    
    'Re-enable screen updates
    Application.ScreenUpdating = True
    Exit Sub

ErrHan:
    Resume ErrExit
End Sub