3
\$\begingroup\$

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
\$\endgroup\$

1 Answer 1

1
\$\begingroup\$

Kudos for using Rubberduck tests - I'm completely and utterly biased (I wrote quite a big chunk of that part of Rubberduck), but IMO there's no cleaner/leaner unit testing framework for VBA code.

If you're not going to have any code in the @TestInitialize/@TestCleanup methods, remove them: that will remove a bit of overhead and make the tests complete faster - if Rubberduck doesn't see any @TestInitialize method in a @TestModule, it will not run it. Conversely, if Rubberduck finds such methods, it will call them before and after every single test.

The OriginalSettings are a module-scope field, but it's only ever referred to in @ModuleInitialize and @ModuleCleanup methods... i.e. it's useless.

If you had @TestInitialize calling OriginalSettings.Restore, then you could have every single test method use it - but since it's your System Under Test (SUT), it's probably a much better idea to have each test work with its own instance. Hence, I'd just remove the field, and delete any dead code and empty setup/teardown methods.


Rubberduck.AssertClass

Every single Assert call you make involves .IsTrue, sometimes in pretty awkward ways:

Assert.IsTrue Application.ScreenUpdating = True
Assert.IsTrue Application.EnableEvents = True
Assert.IsTrue Application.Calculation = xlCalculationAutomatic
Assert.IsTrue Application.ScreenUpdating = False
Assert.IsTrue Application.EnableEvents = False
Assert.IsTrue Application.Calculation = xlCalculationManual
Assert.IsTrue ObjPtr(ThisWorkbook.Application) = ObjPtr(.TargetApplication)
Assert.IsTrue Application.StatusBar = testMessage

The Rubberduck.AssertClass has a rich API that exposes various methods that can simplify your assertions.

IsTrue, IsFalse

Assert.IsTrue works with a Boolean expression, and fails if that expression evaluates to False. By giving it Application.ScreenUpdating = True, you're basically doing this:

If Application.ScreenUpdating = True Then ThisTestPasses

Which you'll agree is redundant =)

Use Assert.IsTrue and Assert.IsFalse to evaluate Boolean expressions accordingly, so instead of these:

Assert.IsTrue Application.ScreenUpdating = True
Assert.IsTrue Application.EnableEvents = True
Assert.IsTrue Application.ScreenUpdating = False
Assert.IsTrue Application.EnableEvents = False

You would have these:

Assert.IsTrue Application.ScreenUpdating
Assert.IsTrue Application.EnableEvents
Assert.IsFalse Application.ScreenUpdating
Assert.IsFalse Application.EnableEvents

And you could even give it an optional message parameter, that gets displayed in the test explorer when the assertion fails:

Assert.IsTrue Application.ScreenUpdating, "ScreenUpdating is unexpectedly still False"
Assert.IsTrue Application.EnableEvents, "EnableEvants is unexpectedly still False"
Assert.IsFalse Application.ScreenUpdating, "ScreenUpdating is unexpectedly True"
Assert.IsFalse Application.EnableEvents, "EnableEvents is unexpectedly True"

Rubberduck 2.x Test Explorer


AreEqual

The AssertClass.AreEqual method fails an assertion when two given values aren't equal. It could have been used here:

Assert.IsTrue Application.Calculation = xlCalculationAutomatic
Assert.IsTrue Application.Calculation = xlCalculationManual
Assert.IsTrue Application.StatusBar = testMessage

Like this - always the expected value first, then the actual:

Assert.AreEqual xlCalculationAutomatic, Application.Calculation
Assert.AreEqual xlCalculationManual, Application.Calculation
Assert.AreEqual testMessage, Application.StatusBar

There's also Assert.AreNotEqual to assert the opposite.


AreSame

Assert.AreEqual works for values. To determine if two objects are the same reference, there's the Assert.AreSame method, which you could have used here:

Assert.IsTrue ObjPtr(ThisWorkbook.Application) = ObjPtr(.TargetApplication)

Like this:

Assert.AreSame ThisWorkbook.Application, .TargetApplication

Much simpler, no? The API gives you Assert.AreNotSame to assert the opposite.

There's also Assert.IsNothing and Assert.IsNotNothing which you can use to test whether an object reference is set or not (but there's no such assertion in your code, so I'm just merely mentioning it for the sake of completion).


What about assumptions?

Every test creates a new instance of the class under test, which is excellent. However the class implements a Class_Initialize handler that modifies its internal state, and you have a test for that which is awesome:

With New ExcelApplicationSettings
    Assert.IsTrue ObjPtr(ThisWorkbook.Application) = ObjPtr(.TargetApplication)
End With

However every single test that uses the global Application instance is implicitly assuming that the GivenDefaultObjectTargetHostApplication test passes. Before you can do this:

Assert.AreEqual xlCalculationAutomatic, Application.Calculation

You need to assert that:

If ObjPtr(ThisWorkbook.Application) <> ObjPtr(.TargetApplication) Then _
    Assert.Inconclusive "sut.TargetApplication must be ThisWorkbook.Application for this test to be meaningful."

That way if you make a change and GivenDefaultObjectTargetHostApplication starts failing, you're not going to have 13 failing tests: you'll have 1 failing and 12 inconclusive. And the name of the failing test should be enough to tell you exactly what assumption your modification broke.


Naming

I think GivenDefaultObjectTargetHostApplication could use a more meaningful name. How about GivenNewInstance_TargetApplicationIsHostAppInstance? Normally I avoid underscores in method names, but test method names have their own guidelines: I like GivenFooThenBar, but your identifiers are GivenFooBar - seems an underscore helps make more sense out of the name: GivenFoo_Bar actually makes the underscore read like an implicit "then".

Naming is hard. Naming test methods is even harder: you want to be able to read them in the test explorer and immediately know what the thing is doing and how it responds to given input.

test explorer

A name like WriteToStatusBar doesn't do much. This comment is confusing, is that copy-pasta leftovers?

'/ Test that the object's default behaviour is to store ThisWorkbook.Application upon creation

With a name like GivenStatusBarMessage_SetsStatusBarTextAsSpecified, there's not really a need for any comment to explain what that test is about.

The important parts:

  • What method is being tested
  • What input is being verified
  • What outcome is expected

Teardown

I think you have an opportunity for a @TestCleanup method here:

TestExit:
    Application.StatusBar = originalMessage
    Exit Sub

Instead of "resetting" Application's state, you could use @TestCleanup and/or @TestInitialize methods to configure/reset the state of Application properties, so that individual test methods don't need to be worried about correctly tearing down.

\$\endgroup\$
7
  • \$\begingroup\$ Thanks for this. OriginalSettings is there to preserve the application state before/after the test module runs, since the tests involve altering it. \$\endgroup\$
    – Kaz
    Sep 30, 2016 at 8:39
  • \$\begingroup\$ And are you saying I should write the "check for correct pointers" test into every single test method? Is there a way to tell RD "This test relies on this other test passing first" \$\endgroup\$
    – Kaz
    Sep 30, 2016 at 8:41
  • \$\begingroup\$ @Kaz actually, tests should not depend on each other, so no. However Class_Initialize can very well be considered an implementation detail (it's private after all), so the test could be outright deleted, and each other test should make its assumptions explicit. \$\endgroup\$ Sep 30, 2016 at 12:03
  • \$\begingroup\$ In that case, is it possible to put a check in Test_Initialise which will make the whole thing inconclusive if it fails? \$\endgroup\$
    – Kaz
    Sep 30, 2016 at 12:07
  • \$\begingroup\$ Sure why not? RE: OriginalSettings - that's why it should be reset after each and every single test, not just when the module has been run. \$\endgroup\$ Sep 30, 2016 at 12:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.