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]