処理速度に影響しそうなものを纏めて止めてみる

昨日は、警告を出さずにシートを削除してみた。
infoment.hatenablog.com

今日も、昨日の続きから。

シート削除時の警告メッセージのように、自動処理中の速度を低下させたり
中断するもの。私の認識では、それは以下の４つだと思う。

1. 画面更新（ScreenUpdating）
2. 警告表示（DisplayAlerts）
3. イベント（EnableEvents）
4. 自動計算（Calculation）

※自動計算は、自動処理の中で計算結果を参照する場合に事故の原因となる
　ため、注意が必要です。

特にWorksheet_Changeイベントでは、処理の際にこれを無効にしておかないと
無限ループに陥る恐れがある。

1. 値が変更された。
2. イベント発生。処理実行。
3. 処理の結果、シートの値が変更された。
4. 1. に戻る。

何度か経験して、悲しい思いをした。

そこで昨日のクラスモジュールに追加して、これらを纏めて入り切りできる
ようにしてみた。

なお、昨日と同様以下は全て、クラスモジュール「AppControl」に記載している。
一連の作りこみが終わったら、いつもと同様まとめて公開する予定。

Option Explicit

Dim BackupDisplayAlerts As Boolean
Dim TempDisplayAlerts As Boolean

Dim BackupScreenUpdating As Boolean
Dim TempScreenUpdating As Boolean

Dim BackupEnableEvents As Boolean
Dim TempEnableEvents As Boolean

Dim BackupCalculation As Boolean
Dim TempCalculation As Boolean

Dim RecoverSetting As Boolean

Dim App As Application

Initializeの時点で、後述のinitを呼び出している。ただしその後に、もう一度
実行して任意の設定を上書き可能とした。

Private Sub Class_Initialize()
    Set App = Application
    
    ' インスタンス作成時点の設定を退避。
    BackupScreenUpdating = App.ScreenUpdating
    BackupDisplayAlerts = App.DisplayAlerts
    BackupEnableEvents = App.EnableEvents
    BackupCalculation = App.Calculation
    
    Call init
End Sub

Public Sub init(Optional screen_updating As Boolean = False, _
                Optional display_alerts As Boolean = False, _
                Optional enable_events As Boolean = False, _
                Optional calculation_ As XlCalculation = xlAutomatic, _
                Optional recover_setting As Boolean = True)
                
    ' 画面更新に関する設定。
    App.ScreenUpdating = screen_updating
    
    ' 警告表示に関する設定。
    App.DisplayAlerts = display_alerts
    
    ' ワークシートイベントの停止に関する設定。
    App.EnableEvents = enable_events
    
    ' 計算方法に関する設定。
    ' 計算を止めると意図しない結果になる場合もあるため、
    ' 初期値は自動計算としている。
    App.Calculation = calculation_
    
    ' ここで変えた設定を、最後に元に戻すかの設定。
    RecoverSetting = recover_setting
    
End Sub

Private Sub Class_Terminate()

    ' 設定の復元。
    If RecoverSetting Then
        App.ScreenUpdating = BackupScreenUpdating
        App.DisplayAlerts = BackupDisplayAlerts
        App.EnableEvents = BackupEnableEvents
        App.Calculation = BackupCalculation
    End If
    
    ' ついでにステータスバーをリセット。
    App.StatusBar = False
    
End Sub

最後の「ステータスバーをリセット」は、おまけです。
次回に続きます。

参考まで。