Did you find something
helpful on my site? Consider a donation!
Heeft u iets gevonden waar u wat aan had? Overweeg dan een donatie!
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 '------------------------------------------------------------------------- '========================================================================= OptionExplicit
Private mcolUndoObjects As Collection Private mUndoObject As clsUndoObject
PublicFunction AddAndProcessObject(oObj As Object, sProperty AsString, vValue AsVariant) AsBoolean Set mUndoObject = New clsUndoObject With mUndoObject Set .ObjectToChange = oObj .NewValue = vValue .PropertyToChange = sProperty mcolUndoObjects.Add mUndoObject If .ExecuteCommand = TrueThen AddAndProcessObject = True Else AddAndProcessObject = False EndIf EndWith EndFunction
PrivateSub Class_Initialize() Set mcolUndoObjects = New Collection EndSub
PrivateSub Class_Terminate() ResetUndo EndSub
PublicSub ResetUndo() While mcolUndoObjects.Count > 0 mcolUndoObjects.Remove (1) Wend Set mUndoObject = Nothing EndSub
PublicSub UndoAll() Dim lCount AsLong ' On Error Resume Next For lCount = mcolUndoObjects.Count To 1 Step -1 Set mUndoObject = mcolUndoObjects(lCount) mUndoObject.UndoChange Set mUndoObject = Nothing Next ResetUndo EndSub
PublicSub UndoLast() Dim lCount AsLong ' 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 EndIf EndSub
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.