有効 ⇔ 無効の切り替えが面倒くさくなった話(邪道?)

Excel VBAにおいて、処理の高速化といえばこれ。

Application.ScreenUpdating = False

画面の更新を一時停止することで、処理の高速化が望める。

また、シートのチェンジイベントに於いて、忘れてならないのがこれ。

Application.EnableEvents = False

例えば、A1の値が変わったら、2倍した値をA1に入力したとする。

A1の値が1になる ⇒ A1に、1×2=2を入力。
A1の値が2になった! ⇒ A1に、2×2=4を入力。
A1の値が4になった! ⇒ ・・・

となり、無限ループに陥る。途中でエラー終了すれば、まだ救いがある。しかし、うっかり「元の値を入力する」などとした日には、永遠に終わらない。

ここでサンプルを紹介。引数の値毎に処理を変え、その場でマクロを抜けている。

Sub test1(val As Long)
    ' 画面の更新を一時停止。
    Application.ScreenUpdating = False
    ' イベント一時停止(無限ループ防止)。
    Application.EnableEvents = False
    
    Select Case val
        Case 1
            ' 何某かの処理。
            ' *****
            
            ' 処理が終わったので、ここで終了。
            Exit Sub
        Case 2
            ' 何某かの処理。
            ' //////
            
            ' 処理が終わったので、ここで終了。
            Exit Sub
    End Select
    
    ' val が 1 または 2 以外の時の処理。
    ' +++++++
    
End Sub

しかしこのままだと冒頭で停止した二つが、そのまま停止しっぱなしとなる。そこで、このように再開処理を追加する。

Sub test1(val As Long)
    ' 画面の更新を一時停止。
    Application.ScreenUpdating = False
    ' イベント一時停止(無限ループ防止)。
    Application.EnableEvents = False
    
'    On Error GoTo er:
    Select Case val
        Case 1
            ' 何某かの処理。
            ' *****
            Application.ScreenUpdating = True
            Application.EnableEvents = True
            ' 処理が終わったので、ここで終了。
            Exit Sub
        Case 2
            ' 何某かの処理。
            ' //////
            Application.ScreenUpdating = True
            Application.EnableEvents = True
            ' 処理が終わったので、ここで終了。
            Exit Sub
    End Select
    
    ' val が 1 または 2 以外の時の処理。
    ' +++++++
   
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

さらに、もしエラー終了した場合、「オフしっ放し」の状態が発生。
そこで、エラートラップを追加する。

Sub test1(val As Long)
    ' 画面の更新を一時停止。
    Application.ScreenUpdating = False
    ' イベント一時停止(無限ループ防止)。
    Application.EnableEvents = False
    
    On Error GoTo er:
    Select Case val
        Case 1
            ' 何某かの処理。
            ' *****
            Application.ScreenUpdating = True
            Application.EnableEvents = True
            ' 処理が終わったので、ここで終了。
            Exit Sub
        Case 2
            ' 何某かの処理。
            ' //////
            Application.ScreenUpdating = True
            Application.EnableEvents = True
            ' 処理が終わったので、ここで終了。
            Exit Sub
    End Select
    
    ' val が 1 または 2 以外の時の処理。
    ' +++++++
   
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    ' 正常終了の場合。
    Exit Sub
    
    ' 異常終了の場合。
er:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

入口が1つで出口が4つだから、戻し処理も4つ必要。これがとても面倒くさい。フラグを立てるなどの方法もあるが、あまり好みではない。
そこで、こんなものを一つ作ってみた。

クラスモジュール(AppControl)
Option Explicit

Public Sub Init(Optional screen_updating As Boolean = False, _
                Optional enable_events As Boolean = False)
    Application.ScreenUpdating = screen_updating
    Application.EnableEvents = enable_events
End Sub

Private Sub Class_Initialize()
    Call Init
End Sub

Private Sub Class_Terminate()
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

クラス生成時に画面更新などを無効化し、クラス破棄時に有効化する。これなら、何度も有効化処理を書く必要が無いと考えたわけだ。

これを先ほどのマクロに反映すると、こうなる。かなりスッキリした。

Sub test1(val As Long)

    ' 画面の更新などを停止。
    Dim ACC As AppControl
    Set ACC = New AppControl
    
    On Error GoTo er:
    Select Case val
        Case 1
            ' *****
            Exit Sub
        Case 2
            ' //////
            Exit Sub
    End Select
    
    ' val が 1 または 2 以外の時の処理。
    ' 意図的にエラー発生。
        Debug.Print 1 / 0
        
    Exit Sub
    
er:
    ' エラー時の処理
    ' ---------
End Sub

早速、実験してみよう。

Sub test2()
    Dim i As Long
        For i = 2 To 3
            Call test1(i)
            MsgBox "i = " & i & " のとき:" & vbNewLine & _
                   Application.ScreenUpdating & vbNewLine & _
                   Application.EnableEvents
        Next
End Sub

結果は ↓ こちら。無効化した画面更新の一時停止(False)などが、ちゃんと「True」に戻っている。
f:id:Infoment:20190818094653g:plain

どうやら、うまくいったようだ。
ただしこのような使い方は、本来のクラスモジュールの使い方からすると、邪道と言われるかもしれない。
ということで、もし引用するとしても、自己使用の範囲でお願いします。

参考まで。