Creating An Undo Handler To Undo Changes Done By Excel VBA

Pages in this article

1. Class Modules (1)
2. Class Modules (2)
3. Implementation
4. Conclusion

Class modules (1)

There are two class modules involved in this technique.

1. clsUndoObject

This class will "hold" the object that has to be changed (and thus possibly changed back). Also any changes to be done to the object are done in this class. Finally, this class keeps score of what the previous values of the changed property are.

2. clsExecAndUndo

This class will hold a collection of all instances of the clsUndoObject class (in simpler words: it will keep a list of all objects that have been changed and know how to undo those changes). And this class will make sure the changes on the objects (both the changes and the undoing of the changes) are carried out.

clsUndoObject

'=========================================================================
' Module    : clsUndoObject
' Company   : JKP Application Development Services (c) 2005
' Author    : Jan Karel Pieterse
' Created   : 31-8-2005
' Purpose   : Class module, Contains each object processed and
'             handles the exection of the command and the Undo
' 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 mUndoObject As Object
Private msProperty As String
Private mvNewValue As Variant
Private mvOldValue As Variant

Public Property Let PropertyToChange(sProperty As String)
    msProperty = sProperty
End Property

Public Property Get PropertyToChange() As String
    PropertyToChange = msProperty
End Property

Public Property Set ObjectToChange(oObj As Object)
    Set mUndoObject = oObj
End Property

Public Property Get ObjectToChange() As Object
    Set ObjectToChange = mUndoObject
End Property

Public Property Let NewValue(vValue As Variant)
    mvNewValue = vValue
End Property

Public Property Get NewValue() As Variant
    NewValue = mvNewValue
End Property

Public Property Let OldValue(vValue As Variant)
    mvOldValue = vValue
End Property

Public Property Get OldValue() As Variant
    OldValue = mvOldValue
End Property

Public Function ExecuteCommand() As Boolean
    ExecuteCommand = False
    If mUndoObject Is Nothing Then
    End If
    If mvNewValue = "" Then
    End If
    If msProperty = "" Then
    End If
    If GetOldValue Then
        SetNewValue
        ExecuteCommand = True
    Else
        'Failed to retrieve old value!
    End If
End Function

Private Function GetOldValue() As Boolean
    Dim oTemp As Object
    Dim lCount As Long
    Dim lProps As Long
    Dim vProps As Variant
    vProps = Split(PropertyToChange, ".")
    lProps = UBound(vProps)
    Set oTemp = ObjectToChange
    For lCount = 0 To lProps - 1
        Set oTemp = CallByName(oTemp, vProps(lCount), VbGet)
    Next
    If TypeOf oTemp Is Range Then
        If LCase(vProps(lProps)) = "value" Then
            vProps(lProps) = "Formula"
        End If
    End If
    OldValue = CallByName(oTemp, vProps(lProps), VbGet)
    If Err.Number = 0 Then
        GetOldValue = True
    Else
        GetOldValue = False
    End If
End Function

Private Function SetNewValue() As Boolean
    Dim oTemp As Object
    Dim lCount As Long
    Dim lProps As Long
    Dim vProps As Variant
    Dim vResult As Variant
    Err.Clear
    Set oTemp = ObjectToChange
    vProps = Split(PropertyToChange, ".")
    lProps = UBound(vProps)
    For lCount = 0 To lProps - 1
        Set oTemp = CallByName(oTemp, vProps(lCount), VbGet)
    Next
    If TypeOf oTemp Is Range Then
        If LCase(vProps(lProps)) = "value" Then
            vProps(lProps) = "Formula"
        End If
    End If
    vResult = CallByName(oTemp, vProps(lProps), VbLet, NewValue)
    If Err.Number = 0 Then
        SetNewValue = True
    Else
        SetNewValue = False
    End If
End Function

Public Function UndoChange()
    Dim oTemp As Object
    Dim lCount As Long
    Dim lProps As Long
    Dim vProps As Variant
    Dim vResult As Variant
    Set oTemp = ObjectToChange
    vProps = Split(PropertyToChange, ".")
    lProps = UBound(vProps)
    For lCount = 0 To lProps - 1
        Set oTemp = CallByName(oTemp, vProps(lCount), VbGet)
    Next
    If TypeOf oTemp Is Range Then
        If LCase(vProps(lProps)) = "value" Then
            vProps(lProps) = "Formula"
        End If
    End If
    vResult = CallByName(oTemp, vProps(lProps), VbLet, OldValue)
    If vResult <> "" Then
        UndoChange = True
    Else
        UndoChange = False
    End If
End Function

The central properties of this class are:

The main functions are: