运行macrosexcel后“撤消”历史button清除
我有一个macros在“Worksheet_SelectionChange”事件触发。 macrosvalidation一列的数据，如果错误的话它会改变单元的背景颜色。
问题是运行macros后，它清除所有文档的变化（Ctrl Z）的历史logging，甚至没有validation其他单元格的历史变化。
我怎么解决这个问题？
谢谢。
正如其他人所说，没有办法阻止工作表更改macros清除撤消堆栈。
作为另一个副作用，无法编写自己的撤销例程，这是一个巨大的麻烦，不能撤销macros。
这是希望MS在未来改变这一点。
我有这个问题，并最终创build自定义撤消function。 除了以下内容，它与本地撤销非常相似。 我相信他们可以多处理一点。
1）自定义撤消不会撤消格式。 只有文字。
2）自定义撤销一直到自定义堆栈的结束。 一旦发生这种情况，堆栈将被清除，并且不会像在本机撤消function中那样在最后两项之间切换。
2.1）没有REDOfunction。
下载此代码的工作副本。
VBAProject布局截图
模块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