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 (1)

Er wordt gebruik gemaakt van 2 klasse modules.

1. clsUndoObject

Deze klasse zal het object bevatten dat later mogelijk veranderd zal worden (en welke verandering dus ook ongedaan moet kunnen worden gemaakt). Ook de veranderingen aan het object zelf worden in deze klasse module uitgevoerd. Om het ongedaan maken te kunnen uitvoeren, zal deze klasse ook de oude waarde van een te wijzigen eigenschap opslaan.

2. clsExecAndUndo

Deze klasse zal een lijst (collectie) met instanties gaan bijhouden van alle instanties van de clsExecAndUndo klasse. In eenvoudiger bewoordingen: de klasse zal een lijst bijhouden met alle objecten en eigenschappen die worden gewijzigd en weten hoe deze wijzigingen ongedaan te maken. Tevens zal het wijzigen van de eigenschappen (zowel de eertse wijziging als later eventueel het ongedaan maken) door deze klasse worden geregeld.

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

De belangrijkste eigenschappen (properties) van deze klasse zijn:

De belangrijkste functies zijn: