Undo mogelijk maken voor macro's in Excel VBA

Klasse modules (2)

clsExecAndUndo

OK, nog een lang stuk programma code (de uitleg volgt eronder)...

'=======================================
' 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
'                                www.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

Een korte uitleg van de hierboven getoonde functies en routines:

Functie/routine	Doel
AddAndProcessObject	Dit is de ingangsroutine van deze klasse. Het ontvangt (als argumenten) het object en de eigenschap die moet worden gewijzigd, alsmede de gewenste nieuwe waarde van de eigenschap. De routine maakt een nieuwe instantie van de klasse clsExecAndUndo voor dit object en voegt deze instantie toe aan een collectie, zodat deze instanties later weer op te vragen zijn om de wijzigingen ongedaan te kunnen maken. De routine roept vervolgens andere routines (in clsExecAndUndo) aan om de vorige waarde te kunnen opslaan en vervolgens de wijziging te kunnen uitvoeren.
ResetUndo	Verwijdert de undo stack van de utility (wordt uitgevoerd wanneer de klasse wordt vernietigd)
UndoAll	Methode die alle uitgevoerde wijzigingen die in de collectie van gewijzigde objecten is opgeslagen ongedaan maakt. Dit is de procedure die wordt aangeroepen wanneer control-z wordt gekozen of Bewerken, ongedaan maken. De procedure roept voor de hele collectie van gewijzigde objecten (elke instantie van clsExecAndUndo) de routine "UndoChange" aan uit die klasse module.
UndoLast	Maakt slechts de laatste actie ongedaan. Deze routine zal aan een sneltoets of menuknop kunnen worden toegekend via een sub in een normale module.
UndoCount	Geeft het aantal objecten dat gewijzigd is.

Hiermee is de beschrijving van de twee centrale klasse modules van deze techniek compleet. De volgende pagina beschrijft hoe deze moeten worden geïmplementeerd.