エクセルVBA ScreenUpdatingとEnableEventsを戻し忘れないクラス
処理速度的に画面更新を停めたくてApplication.ScreenUpdatingを切ったり、セルチェンジイベントの発生が循環したらイヤンな時にApplication.EnableEventsを切ることが良くあります。一方、エラーなど複雑な分岐でExit Subをやると、しょっちゅうどっかで戻し忘れてしまいます(私だけ?)Application.EnableEventsなんかはとくに「アレ、アレレ?」なことになります(アレやっぱり私だけ?
注意力の話はともかく既知のヒューマンエラーを放置するのは良くないので、こんな時こそオブジェクト指向。処理の途中で呼び出したサブルーチンや関数がその中で再びクラスを多重生成しても大丈夫な、参照カウンタクラスのようなものを作ってみました。クラスの生成時にグローバルなカウンタを回し、その際カウンタがゼロだったらScreenUpdatingをFalseにします。クラス破棄でカウンタを減らし、ゼロに戻ってきたら、Trueに戻します。
「カウンタ式はおおげさかな〜」という修正版はコチラ>>http://d.hatena.ne.jp/tiri_tomato/20110910/1315777405
使用例
Private Sub Worksheet_Change(ByVal Target As Range) Dim clsEventDisabler As IEventsDisabler ' Changeイベント発生を停止するオマジナイ Dim cls〜の寿命で効果は自動消滅 Set clsEventDisabler = New IEventsDisabler Dim clsScrUpdatingDisabler As IScrUpdatingDisabler ' スクリーン更新を停止するオマジナイ Dim cls〜の寿命で効果は自動消滅 Set clsScrUpdatingDisabler = New IScrUpdatingDisabler '好きな処理 Dim rng As Range For Each rng In Target.Cells If (条件) Then Exit Sub ' 途中で抜けても大丈夫 Next rng End Sub
ファイル構成
- 標準モジュール modDisabler
- クラス IScrUpdatingDisabler
- クラス IEventsDisabler
ソースコード
◇ 標準モジュール modDisabler
Option Explicit Private Const ScrUpdatingDisabler_Enable = True ' デバッグ用停止フラグ。FalseにするとDisablerModule_ScrUpdating〜()は機能停止。 Private ctDisableScrUpdating As Long Private Const EventsDisabler_Enable = True ' デバッグ用停止フラグ。FalseにするとDisablerModule_Events〜()は機能停止。 Private ctDisableEvent As Long Public Sub DisablerModule_Restore() ' デバッグ中の実行中断で、各機能が無効になりっぱなしになってしまった場合に呼び出します。 ctDisableScrUpdating = 0 Application.ScreenUpdating = True ctDisableEvent = 0 Application.EnableEvents = True End Sub Public Function DisablerModule_ScrUpdatingDisable() As Long ' Application.ScreenUpdatingを無効に設定します If ScrUpdatingDisabler_Enable Then ' 無効にする If ctDisableScrUpdating = 0 Then Application.ScreenUpdating = False ctDisableScrUpdating = ctDisableScrUpdating + 1 End If DisablerModule_ScrUpdatingDisable = ctDisableScrUpdating ' デバッグ情報としてリターン End Function Public Function DisablerModule_ScrUpdatingEnable() As Long ' Application.ScreenUpdatingを有効に戻します If ScrUpdatingDisabler_Enable Then ' 有効にする ctDisableScrUpdating = ctDisableScrUpdating - 1 If ctDisableScrUpdating <= 0 Then Application.ScreenUpdating = True ctDisableScrUpdating = 0 End If End If DisablerModule_ScrUpdatingEnable = ctDisableScrUpdating ' デバッグ情報としてリターン End Function Public Sub DisablerModule_ScrUpdatingFlush() ' Application.ScreenUpdatingを一時的に有効にします。 Dim reg As Boolean: reg = Application.ScreenUpdating Application.ScreenUpdating = True ' 有効化 If reg = False Then Application.ScreenUpdating = False ' 元に戻す End Sub Public Function DisablerModule_EventsDisable() As Long ' Application.EnableEventsを無効に設定します。 If EventsDisabler_Enable Then If ctDisableEvent = 0 Then Application.EnableEvents = False ctDisableEvent = ctDisableEvent + 1 End If DisablerModule_EventsDisable = ctDisableEvent ' デバッグ情報としてリターン End Function Public Function DisablerModule_EventsEnable() As Long ' Application.EnableEventsを有効に戻します。 If EventsDisabler_Enable Then ctDisableEvent = ctDisableEvent - 1 If ctDisableEvent <= 0 Then Application.EnableEvents = True ctDisableEvent = 0 End If End If DisablerModule_EventsEnable = ctDisableEvent ' デバッグ情報としてリターン End Function
DisablerModule_Restore()
デバッグ用サブルーチン。デバッグ中にAssertしたり中断すると、たいていクラスの生成回数と破棄回数がつりあわなくなるので、このサブルーチンにカーソルしてF5を叩けばすぐ戻せるように復旧処理を作っておきます。
DisablerModule_ScrUpdatingDisable()
DisablerModule_ScrUpdatingEnable()
ScreenUpdatingのFalse/Trueを設定するための無効カウンタインクリメント/デクリメント関数。これらの関数はIScrUpdatingDisablerクラスを経由して呼び出すもので、通常のエンドプログラミングでこれらの関数を直接呼ぶことはありません。
DisablerModule_ScrUpdatingFlush()
処理の途中でScreenUpdatingを一瞬だけTrueに戻すサブルーチン。ScreenUpdatingの無効/有効状態に関わらずいつでも使用できます。
DisablerModule_EventsDisable()
DisablerModule_EventsEnable()
EnableEventsのFalse/Trueを設定するための無効カウンタインクリメント/デクリメント関数。これらの関数はIEventsDisablerクラスを経由して呼び出すもので、通常のエンドプログラミングでこれらの関数を直接呼ぶことはありません。
◇ クラス IScrUpdatingDisabler
Public Sub Class_Initialize() DisablerModule_ScrUpdatingDisable End Sub Public Sub Class_Terminate() DisablerModule_ScrUpdatingEnable End Sub
インスタンスをNewするときDisablerModule_ScrUpdatingDisableを実行し、変数のスコープや寿命を迎える時にDisablerModule_ScrUpdatingEnableを実行するためだけのクラスです。
◇ クラス IEventsDisabler
Public Sub Class_Initialize() DisablerModule_EventsDisable End Sub Public Sub Class_Terminate() DisablerModule_EventsEnable End Sub
インスタンスをNewするときDisablerModule_EventsDisableを実行し、変数のスコープや寿命を迎える時にDisablerModule_EventsEnableを実行するためだけのクラスです。
VBは文法やガベージコレクションの細かい仕様に詳しくないので結構不安なんですが、しばらくいじってみたところ、とくに問題なく使えるようです。それにしてもVB6ベースのVBAはfriendのようなアクセス制限も継承もないので、手の打ちどころが結構難しいですね。
しかしいきなり長くなった。このペース絶対続かない。^^