チリペヂィア

リンクフリー。サンプルコードなどは関連記事内でライセンスについて明示されない限り商用利用なども自由に行って構いませんが、自己責任でお願いします。またこれら日記内容の著作権自体は放棄していません。引用部分については引用元の権利に従ってください。

エクセル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のようなアクセス制限も継承もないので、手の打ちどころが結構難しいですね。

しかしいきなり長くなった。このペース絶対続かない。^^