Abstract

Mein ehemaliger Kollege Jon T. entwickelte die kleinste mir bekannte sinnvolle VBA Klasse: Mit SystemState kann man Systemstatusvariablen leicht speichern und für eigene Zwecke optimieren.

Um die Programmausführung zu beschleunigen, schreibt man normalerweise zu Beginn eines VBA Makros

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

und am Ende des Makros

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Mit dem Klassenmodul SystemState schreibt man am Start lediglich

Dim state As SystemState
Set state = New SystemState
'Bitte beachten: Dies kann NICHT mit "Dim state as New SystemState" abgekürzt werden!

und am Ende

Set state = Nothing 'Nicht einmal nötig - dies wird automatisch gemacht

Variablen

Man kann die folgenden Systemstatusvariablen kontrollieren:


Variable Status Kommentar / Zu optimieren durch …
Calculation xlCalculationAutomatic, xlCalculationManual, xlCalculationSemiautomatic Bestimmt ob nach jeder Zelländerung eine Neuberechnung durchgeführt wird. Auf xlCalculationManual setzen
Cursor xlDefault, xlBeam, xlNorthwestArrow, xlWait Dies ist lediglich eine Anzeige. Am besten nicht anfassen - es sei denn, man möchte den Debug Modus z. B. mit einem Sanduhr Zeiger beginnen
DisplayAlerts True, False Auf False setzen um Systemrückfragen abzuschalten
EnableAnimations True, False Ab Excel Version 2016 kann man hiermit Excel’s Bildschirmanimationen abschalten
EnableEvents True, False Auf False setzen um Ereignisprozeduren an der Ausführung zu hindern
Interactive True, False Am besten nicht anfassen - es sei denn, man möchte unbedingt alle Tastatureingaben verhindern
PrintCommunication True, False Auf False setzen um Seiteneinstellungen zu ändern ohne auf Rückantwort vom Drucker zu warten
ScreenUpdating True, False Auf False setzen um Bildschirmaktualisierungen während der Programmausführung abzuschalten
StatusBar False, “Irgendeine beliebige Benutzerinformation” Der Text wird in der Statuszeile (unterste Bildschirmzeile) gezeigt. Auf False setzen um die Anzeige zu löschen

Appendix – Programmcode der Klasse SystemState

Bitte den folgenden Programmcode in ein Klassenmodul mit dem Namen SystemState und nicht in ein normales Modul einfügen.

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

'
'This class has been developed by my former colleague Jon T.
'I adapted it to newer Excel versions. Any errors are mine for sure.
'Source (EN): http://www.sulprobil.com/systemstate_en/
'Source (DE): http://www.bplumhoff.de/systemstate_de/
'(C) (P) by Jon T., Bernd Plumhoff 16-Dec-2023 PB V1.4
'
'The class is called SystemState.
'It can of course be used in nested subroutines.
'
'This module provides a simple way to save and restore key excel
'system state variables that are commonly changed to speed up VBA code
'during long execution sequences.
'
'
'Usage:
'    Save() is called automatically on creation and Restore() on destruction
'    To create a new instance:
'        Dim state as SystemState
'        Set state = New SystemState
'    Warning:
'        "Dim state as New SystemState" does NOT create a new instance
'
'
'    Those wanting to do complicated things can use extended API:
'
'    To save state:
'       Call state.Save()
'
'    To restore state and in cleanup code: (can be safely called multiple times)
'       Call state.Restore()
'
'    To restore Excel to its default state (may upset other applications)
'       Call state.SetDefaults()
'       Call state.Restore()
'
'    To clear a saved state (stops it being restored)
'       Call state.Clear()
'
Private Type m_SystemState
    Calculation As XlCalculation
    Cursor As XlMousePointer
    DisplayAlerts As Boolean
    EnableAnimations As Boolean   'From Excel 2016 onwards
    EnableEvents As Boolean
    Interactive As Boolean
    PrintCommunication As Boolean 'From Excel 2010 onwards
    ScreenUpdating As Boolean
    StatusBar As Variant
    m_saved As Boolean
End Type

'
'Instance local copy of m_State?
'
Private m_State As m_SystemState

'
'Reset a saved system state to application defaults
'Warning: restoring a reset state may upset other applications
'
Public Sub SetDefaults()
    m_State.Calculation = xlCalculationAutomatic
    m_State.Cursor = xlDefault
    m_State.DisplayAlerts = True
    m_State.EnableAnimations = True
    m_State.EnableEvents = True
    m_State.Interactive = True
    On Error Resume Next 'In case no printer is installed
    m_State.PrintCommunication = True
    On Error GoTo 0
    m_State.ScreenUpdating = True
    m_State.StatusBar = False
    m_State.m_saved = True 'Effectively we saved a default state
End Sub

'
'Clear a saved system state (stop restore)
'
Public Sub Clear()
    m_State.m_saved = False
End Sub

'
'Save system state
'
Public Sub Save(Optional SetFavouriteParams As Boolean = False)
    If Not m_State.m_saved Then
        m_State.Calculation = Application.Calculation
        m_State.Cursor = Application.Cursor
        m_State.DisplayAlerts = Application.DisplayAlerts
        m_State.EnableAnimations = Application.EnableAnimations
        m_State.EnableEvents = Application.EnableEvents
        m_State.Interactive = Application.Interactive
        On Error Resume Next 'In case no printer is installed
        m_State.PrintCommunication = Application.PrintCommunication
        On Error GoTo 0
        m_State.ScreenUpdating = Application.ScreenUpdating
        m_State.StatusBar = Application.StatusBar
        m_State.m_saved = True
    End If
    If SetFavouriteParams Then
        Application.Calculation = xlCalculationManual
        Application.DisplayAlerts = False
        Application.EnableAnimations = False
        Application.EnableEvents = False
        On Error Resume Next 'In case no printer is installed
        Application.PrintCommunication = False
        On Error GoTo 0
        Application.ScreenUpdating = False
        Application.StatusBar = False
    End If
End Sub

'
'Restore system state
'
Public Sub Restore()
    If m_State.m_saved Then
        'We check now before setting Calculation because setting
        'Calculation will clear cut/copy buffer
        If Application.Calculation <> m_State.Calculation Then
            Application.Calculation = m_State.Calculation
        End If
        Application.Cursor = m_State.Cursor
        Application.DisplayAlerts = m_State.DisplayAlerts
        Application.EnableAnimations = m_State.EnableAnimations
        Application.EnableEvents = m_State.EnableEvents
        Application.Interactive = m_State.Interactive
        On Error Resume Next 'In case no printer is installed
        Application.PrintCommunication = m_State.PrintCommunication
        On Error GoTo 0
        Application.ScreenUpdating = m_State.ScreenUpdating
        If m_State.StatusBar = "FALSE" Then
            Application.StatusBar = False
        Else
            Application.StatusBar = m_State.StatusBar
        End If
    End If
End Sub
 
'
'By default save when we are created
'
Private Sub Class_Initialize()
    Call Save(SetFavouriteParams:=True)
End Sub
 
'
'By default restore when we are destroyed
'
Private Sub Class_Terminate()
    Call Restore
End Sub

Download

Bitte den Haftungsausschluss im Impressum beachten.

systemstate.xlsm [29 KB Excel Datei, Download und Nutzung auf eigene Gefahr]