This previous iteration of this question can be found here
A utility class to handle the state of the Application object.
- Storing the application's initial state (
ScreenUpdating, EnableEvents, Calculation
) - Disabling those settings for performance improvements
- Restoring the original state
- Operations that may need to temporarily modify Application Settings (Currently, writing to the StatusBar)
Also comes with a module of Unit Tests (courtesy of Rubberduck's Unit Testing framework).
How can I make it even better?
I'm considering changing the name to ExcelApplicationState
to make it clearer that it's a state-persistence object. Thoughts?
Example Usage
Sub Example()
With New ExcelApplicationSettings '/ Store happens here
.Disable
'/ Code
'/ Code
.WriteToStatusBar "Some Status Update"
'/ Code
'/ Code
'/ Code
.WriteToStatusBar "Operation Complete"
End With '/ Restore happens here
End Sub
Module ExcelApplicationSettings
'@Folder Application_Settings
Option Explicit
'/ Object to store, reset and restore application settings for an Excel Application Instance
'/ Default Behaviour:
'/ When this class is created, immmediately set and store the application object that contains this workbook
'/ When this class is terminated, immediately restore the original settings
Private Type appSettings
TargetApplication As Excel.Application
ScreenUpdating As Boolean
EnableEvents As Boolean
Calculation As XlCalculation
End Type
Private this As appSettings
Public Property Set TargetApplication(ByVal app As Excel.Application)
Set this.TargetApplication = app
Store
End Property
Public Property Get TargetApplication() As Excel.Application
Set TargetApplication = this.TargetApplication
End Property
Private Sub Class_Initialize()
Set TargetApplication = ThisWorkbook.Application
End Sub
Private Sub Class_Terminate()
Restore
End Sub
Public Sub WriteToStatusBar(ByVal displayMessage As String)
With New ExcelApplicationSettings
this.TargetApplication.ScreenUpdating = True
this.TargetApplication.StatusBar = displayMessage
End With
End Sub
Private Sub Store()
'/ Stores the target application's settings
With this.TargetApplication
this.ScreenUpdating = .ScreenUpdating
this.EnableEvents = .EnableEvents
this.Calculation = .Calculation
End With
End Sub
Public Sub Restore()
'/ Sets the target's application settings back to their last stored values
With this.TargetApplication
.ScreenUpdating = this.ScreenUpdating
.EnableEvents = this.EnableEvents
.Calculation = this.Calculation
End With
End Sub
Public Sub Disable()
'/ Sets the target's application settings to "off"
With this.TargetApplication
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub Reset()
'/ Restore application settings to defaults
With this.TargetApplication
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Module ExcelApplicationSettings_Tests
'@Folder Application_Settings
Option Explicit
Option Private Module
'@TestModule
Private Assert As Object
Private OriginalSettings As ExcelApplicationSettings
'@ModuleInitialize
Public Sub ModuleInitialize()
'this method runs once per module.
Set Assert = CreateObject("Rubberduck.AssertClass")
Set OriginalSettings = New ExcelApplicationSettings
End Sub
'@ModuleCleanup
Public Sub ModuleCleanup()
'this method runs once per module.
OriginalSettings.Restore
Set OriginalSettings = Nothing
End Sub
'@TestInitialize
Public Sub TestInitialize()
'this method runs before every test in the module.
End Sub
'@TestCleanup
Public Sub TestCleanup()
'this method runs after every test in the module.
End Sub
'@TestMethod
Public Sub GivenFalseResetScreenUpdating()
On Error GoTo TestFail
Application.ScreenUpdating = False
With New ExcelApplicationSettings
.Reset
Assert.Istrue Application.ScreenUpdating = True
End With
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub GivenFalseResetEnableEvents()
On Error GoTo TestFail
Application.EnableEvents = False
With New ExcelApplicationSettings
.Reset
Assert.Istrue Application.EnableEvents = True
End With
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub GivenManualResetCalculation()
On Error GoTo TestFail
Application.Calculation = xlCalculationManual
With New ExcelApplicationSettings
.Reset
Assert.Istrue Application.Calculation = xlCalculationAutomatic
End With
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub GivenTrueDisableScreenUpdating()
On Error GoTo TestFail
Application.ScreenUpdating = True
With New ExcelApplicationSettings
.Disable
Assert.Istrue Application.ScreenUpdating = False
End With
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub GivenTrueDisableEnableEvents()
On Error GoTo TestFail
Application.EnableEvents = True
With New ExcelApplicationSettings
.Disable
Assert.Istrue Application.EnableEvents = False
End With
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub GivenAutomaticDisableCalculation()
On Error GoTo TestFail
Application.Calculation = xlCalculationAutomatic
With New ExcelApplicationSettings
.Disable
Assert.Istrue Application.Calculation = xlCalculationManual
End With
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub GivenScreenUpdatingRestoreOnTerminate()
On Error GoTo TestFail
Application.ScreenUpdating = True
With New ExcelApplicationSettings '/ Store happens here
Application.ScreenUpdating = False
End With '/ Restore happens here
Assert.Istrue Application.ScreenUpdating = True
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub GivenEnableEventsRestoreOnTerminate()
On Error GoTo TestFail
Application.EnableEvents = True
With New ExcelApplicationSettings '/ Store happens here
Application.EnableEvents = False
End With '/ Restore happens here
Assert.Istrue Application.EnableEvents = True
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub GivenCalculationRestoreOnTerminate()
On Error GoTo TestFail
Application.Calculation = xlCalculationAutomatic
With New ExcelApplicationSettings '/ Store happens here
Application.Calculation = xlCalculationManual
End With '/ Restore happens here
Assert.Istrue Application.Calculation = xlCalculationAutomatic
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub GivenDefaultObjectTargetHostApplication()
'/ Test that the object's default behaviour is to store ThisWorkbook.Application upon creation
On Error GoTo TestFail
With New ExcelApplicationSettings
Assert.Istrue ObjPtr(ThisWorkbook.Application) = ObjPtr(.TargetApplication)
End With
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub WriteToStatusBar()
'/ Test that the object's default behaviour is to store ThisWorkbook.Application upon creation
On Error GoTo TestFail
Dim originalMessage As String
originalMessage = Application.StatusBar
Dim testMessage As String
testMessage = "Test Message"
With New ExcelApplicationSettings
.WriteToStatusBar testMessage
Assert.Istrue Application.StatusBar = testMessage
End With
TestExit:
Application.StatusBar = originalMessage
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
Application.StatusBar = originalMessage
End Sub
'@TestMethod
Public Sub PreserveFalseScreenUpdatingAfterWriteToStatusBar()
'/ Check that writing to status bar doesn't change the state of Application.ScreenUpdating
On Error GoTo TestFail
Dim originalMessage As String
originalMessage = Application.StatusBar
Dim testMessage As String
testMessage = "Test Message"
With New ExcelApplicationSettings
Application.ScreenUpdating = False
.WriteToStatusBar testMessage
Assert.Istrue Application.ScreenUpdating = False
End With
TestExit:
Application.StatusBar = originalMessage
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
Application.StatusBar = originalMessage
End Sub
'@TestMethod
Public Sub PreserveTrueScreenUpdatingAfterWriteToStatusBar()
'/ Check that writing to status bar doesn't change the state of Application.ScreenUpdating
On Error GoTo TestFail
Dim originalMessage As String
originalMessage = Application.StatusBar
Dim testMessage As String
testMessage = "Test Message"
With New ExcelApplicationSettings
Application.ScreenUpdating = True
.WriteToStatusBar testMessage
Assert.Istrue Application.ScreenUpdating = True
End With
TestExit:
Application.StatusBar = originalMessage
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
Application.StatusBar = originalMessage
End Sub