运行宏excel后清除“撤消”历史按钮

Posted 2023-04-13

【中文标题】运行宏excel后清除“撤消”历史按钮

【英文标题】："Undo" history button clear after run macro excel

【发布时间】：2011-10-17 19:31:31

【问题描述】：

我有一个在 "Worksheet_SelectionChange" 事件上触发的宏。宏验证一列数据，如果错误则改变单元格的背景颜色。

问题是在运行宏之后，它清除了所有文档的更改历史（Ctrl Z），甚至是我没有验证的其他单元格的历史更改。

我该如何解决这个问题？

谢谢。

【问题讨论】：

有时我就是这样的火鸡，来吧：***.com/questions/7004754/…

刚刚看到这个：spreadsheetpage.com/index.php/tip/undoing_a_vba_subroutine

您是否可以在不使用宏的情况下使用 Excel 的内置数据验证和/或条件格式功能来实现相同的功能？如果你能走这条路，那在我看来是最好的解决方案。

我第二个@Excelllll的建议

第三个 Exceellll 的建议。虽然我通常喜欢 J Walk 的提示，但我不喜欢使用数组来保存先前的数据、xl 应用程序设置等。将信息存储在隐藏的工作表中要强大得多

【参考方案1】：

我遇到了这个问题，最后不得不创建自定义撤消功能。 除了以下内容外，它的工作方式与本机撤消非常相似。我相信只要多加注意就可以处理它们。

1) 自定义撤消不会撤消格式设置。只有文字。

2) 自定义撤消一直到自定义堆栈的末尾。一旦发生这种情况，堆栈就会被清除，并且不会像在本机撤消功能中那样在最后两项之间切换。

2.1) 没有 REDO 功能。

Download a working copy of this code.

VBAProject Layout Screenshot

模块 UndoModule

Public UndoStack() As UndoStackEntry
Private Const UndoMaxEntries = 50

Public Sub SaveUndo(ByVal newUndo As UndoStackEntry)

    'Save the last undo object
    If Not newUndo Is Nothing Then
        Call AddUndo(newUndo)
    End If

End Sub

Public Sub Undo()

    'Appy last undo from the stack and remove it from the array
    Dim previousEdit As UndoStackEntry
    Set previousEdit = GetLastUndo()
    If Not previousEdit Is Nothing Then
        Dim previousEventState As Boolean: previousEventState = Application.EnableEvents
        Application.EnableEvents = False
        Range(previousEdit.Address).Select
        Range(previousEdit.Address).Value = previousEdit.Value
        Application.EnableEvents = previousEventState

        Call RemoveLastUndo
    End If

End Sub

Private Function AddUndo(newUndo As UndoStackEntry) As Integer

    If UndoMaxEntries < GetCount() Then
        Call RemoveFirstUndo
    End If

    On Error GoTo ErrorHandler

    ReDim Preserve UndoStack(UBound(UndoStack) + 1)
    Set UndoStack(UBound(UndoStack)) = newUndo

    AddUndo = UBound(UndoStack)

ExitFunction:
    Exit Function

ErrorHandler:
    ReDim UndoStack(0)
    Resume Next

End Function

Private Function GetLastUndo() As UndoStackEntry

    Dim undoCount As Integer: undoCount = GetCount()
    If undoCount > 0 Then
        Set GetLastUndo = UndoStack(undoCount - 1)
    End If

End Function

Private Function RemoveFirstUndo() As Boolean

    On Error GoTo ExitFunction

    RemoveFirstUndo = False
    Dim i As Integer
    For i = 1 To UBound(UndoStack)
        Set UndoStack(i - 1) = UndoStack(i)
    Next i
    ReDim Preserve UndoStack(UBound(UndoStack) - 1)
    RemoveFirstUndo = True

    ExitFunction:
       Exit Function

End Function

Private Function RemoveLastUndo() As Boolean

    RemoveLastUndo = False
    Dim undoCount As Integer: undoCount = GetCount()
    If undoCount > 1 Then
        ReDim Preserve UndoStack(undoCount - 2)
        RemoveLastUndo = True
    ElseIf undoCount = 1 Then
        Erase UndoStack
        RemoveLastUndo = True
    End If

End Function

Private Function GetCount() As Long

    GetCount = 0
    On Error Resume Next
    GetCount = UBound(UndoStack) + 1

End Function

类模块 UndoStackEntry

 Public Address As String
 Public Value As Variant

还需要附加到 WORKBOOK Excel 对象上的以下事件。

Public Sub WorkbookUndo()

    On Error GoTo ErrHandler
    ThisWorkbook.ActiveSheet.PageUndo

ErrExit:
    Exit Sub

ErrHandler:
    On Error GoTo ErrExit
    Application.Undo
    Resume ErrExit

End Sub

最后，您需要撤消工作的每个工作表都应将以下代码附加到其事件中。

Dim tmpUndo As UndoStackEntry
Dim pageUndoStack() As UndoStackEntry

Private Sub OnSelectionUndoCapture(ByVal Target As Range)
    Set tmpUndo = New UndoStackEntry
    tmpUndo.Address = Target.Address
    tmpUndo.Value = Target.Value
    UndoModule.UndoStack = pageUndoStack
End Sub

Private Sub OnChangeUndoCapture(ByVal Target As Range)
    Application.OnKey "^z", "ThisWorkbook.WorkbookUndo"
    Application.OnUndo "Undo Procedure", "ThisWorkbook.WorkbookUndo"

    If Not Application.Intersect(Target, Range(tmpUndo.Address)) Is Nothing Then
        If Target.Value <> tmpUndo.Value Or Empty = Target.Value Then
            UndoModule.UndoStack = pageUndoStack
            Call UndoModule.SaveUndo(tmpUndo)
            pageUndoStack = UndoModule.UndoStack
        End If
    End If
End Sub

Public Sub PageUndo()
    UndoModule.UndoStack = pageUndoStack
    Call UndoModule.Undo
    pageUndoStack = UndoModule.UndoStack
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    'Stash away the value of the first cell in the selected range
    On Error Resume Next

    Call OnSelectionUndoCapture(Target)
    oldValue = Target.Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error Resume Next

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    If tmpUndo.Value <> Target.Value Then
        'Do some stuff
    End If

    Call OnChangeUndoCapture(Target)

    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

【讨论】：

但是重做动作呢？

在jkp-ads.com/Articles/UndoWithVBA00.asp

中有一个更好的解决方案可以处理格式的变化

【参考方案2】：

正如其他人所说，没有办法阻止更改工作表的宏清除撤消堆栈。

另一个副作用是，如果不编写自己的撤消例程，您也无法撤消宏，这可能会很麻烦。

希望 MS 在未来改变这一点。