Creating An Undo Handler To Undo Changes Done By Excel VBA
Pages in this article
Class modules (2)
clsExecAndUndo
OK, another big piece of code (explanation below the code)...
'===================================
' Module : clsExecAndUndo
' Company : JKP Application Development Services (c) 2005
' Author : Jan Karel Pieterse
' Created : 31-8-2005
' Purpose : Class module, stores the objects processed and
'
handles the exection of the commands
' Copyright : This code is free for you to use for applications
'
for personal use.
'
It is not allowed to use this for a commercial program,
'
unless you have my consent.
'
If you want to include this code in freeware, make sure you add :
'-------------------------------------------------------------------------
' This code originates from : Jan Karel Pieterse
' Company
: JKP Application Development Services (c) 2005
'
jkp-ads.com
'-------------------------------------------------------------------------
'=====================================
Option Explicit
Private mcolUndoObjects As Collection
Private mUndoObject As clsUndoObject
Public Function AddAndProcessObject(oObj As Object, sProperty As String,
vValue As Variant) As Boolean
Set mUndoObject = New clsUndoObject
With mUndoObject
Set .ObjectToChange = oObj
.NewValue = vValue
.PropertyToChange = sProperty
mcolUndoObjects.Add mUndoObject
If .ExecuteCommand = True Then
AddAndProcessObject = True
Else
AddAndProcessObject = False
End If
End With
End Function
Private Sub Class_Initialize()
Set mcolUndoObjects = New Collection
End Sub
Private Sub Class_Terminate()
ResetUndo
End Sub
Public Sub ResetUndo()
While mcolUndoObjects.Count > 0
mcolUndoObjects.Remove (1)
Wend
Set mUndoObject = Nothing
End Sub
Public Sub UndoAll()
Dim lCount As Long
' On Error Resume Next
For lCount = mcolUndoObjects.Count To 1 Step -1
Set mUndoObject =
mcolUndoObjects(lCount)
mUndoObject.UndoChange
Set mUndoObject = Nothing
Next
ResetUndo
End Sub
Public Sub UndoLast()
Dim lCount As Long
' On Error Resume Next
If mcolUndoObjects.Count >= 1 Then
Set mUndoObject =
mcolUndoObjects(mcolUndoObjects.Count)
mUndoObject.UndoChange
mcolUndoObjects.Remove
mcolUndoObjects.Count
Set mUndoObject = Nothing
Else
ResetUndo
End If
End Sub
Public Function UndoCount() As Long
UndoCount = mcolUndoObjects.Count
End Function
Short explanation of the subs and functions shown above
That sums up the two central (class-) modules of this example. The next page will describe implementation of the technique.