Undo mogelijk maken voor macro's in Excel VBA

Pagina's in dit artikel

1. Klasse Modules (1)
2. Klasse Modules (2)
3. Implementatie
4. Conclusie

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
'                                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:

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

Veelgestelde vragen