Excel VBA 逆引き集 | イベントクラス

Excel VBA
スポンサーリンク

ねらい:イベントを「クラス」で受け止め、暴走せず拡張しやすいVBAへ

イベントクラスは、散らばりがちなイベント処理(Workbook/Worksheet/アプリ/フォーム)をクラスに閉じ込めて一元管理する設計です。WithEventsを使い、発火→検証→サービス呼び出しの流れをクラスに固定すると、再帰暴走や多重ハンドラ、責務混在を防ぎながら、あとから機能を足しても壊れません。

重要ポイントの深掘り

イベントは「Excelが呼ぶコールバック」です。重い処理をイベント内に書かず、検証や受付だけ行い、本処理はサービスへ委譲するのが鉄則です。EnableEventsのON/OFFで再帰発火を制御し、スコープ(寿命)を正しく設計すると、長期運用でも安定します。


イベントクラスの基本:WithEventsで「どのイベントを監視するか」を明示する

WithEventsの仕組みと寿命

WithEventsは、そのオブジェクトのイベントを「クラスで受ける」ための宣言です。インスタンスが生きている間だけイベントを受けます。ローカル変数だとすぐ破棄されるため、モジュールレベルで保持します。

' CAppEvents.cls(アプリケーション全体のイベント受け)
Option Explicit

Public WithEvents App As Application

Private Sub Class_Initialize()
    Set App = Application
End Sub

Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
    Debug.Print "開いたブック:", Wb.Name
End Sub

Private Sub App_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    ' 軽い受付だけ。重い処理は委譲
    If Not Intersect(Target, Sh.Range("D:D")) Is Nothing Then
        If Not IsNumeric(Target.Value) Or Target.Value < 0 Or Target.Value > 100 Then
            Application.EnableEvents = False
            Target.Value = ""
            Application.EnableEvents = True
            MsgBox "Scoreは0~100の数値です。", vbExclamation
        End If
    End If
End Sub
VB

グローバルに保持して寿命を確保する

' ThisWorkbook(起動時にイベントクラスを有効化)
Option Explicit
Private gAppEv As CAppEvents

Private Sub Workbook_Open()
    Set gAppEv = New CAppEvents  ' 存在している間はイベントを受ける
End Sub
VB

ワークシートイベントをクラスで束ねる:複数シートを同じロジックで扱う

1枚のシートを監視するクラス

' CSheetEvents.cls
Option Explicit

Public WithEvents Ws As Worksheet

Public Sub Init(ByVal target As Worksheet)
    Set Ws = target
End Sub

Private Sub Ws_Change(ByVal Target As Range)
    If Not Intersect(Target, Ws.Range("D:D")) Is Nothing Then
        If Not IsNumeric(Target.Value) Or Target.Value < 0 Or Target.Value > 100 Then
            Application.EnableEvents = False
            Target.Value = ""
            Application.EnableEvents = True
            MsgBox Ws.Name & ": Scoreは0~100の数値です。", vbExclamation
        End If
    End If
End Sub

Private Sub Ws_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Ws.Range("A:A")) Is Nothing Then
        Cancel = True
        MsgBox "EmpNo: " & CStr(Target.Value)
    End If
End Sub
VB

複数シートに同じ監視を差し込む

' ThisWorkbook(対象シートにイベントクラスをアタッチ)
Option Explicit
Private gSheets As Collection

Private Sub Workbook_Open()
    Set gSheets = New Collection
    AttachSheetEvents Worksheets("Input")
    AttachSheetEvents Worksheets("Input2")
End Sub

Private Sub AttachSheetEvents(ByVal ws As Worksheet)
    Dim ev As New CSheetEvents
    ev.Init ws
    gSheets.Add ev  ' コレクション保持で寿命確保
End Sub
VB

フォーム・ボタンのイベントをクラスで管理:大量コントロールでも責務が分かる

同じ動きを複数ボタンに与える

' CButtonEvents.cls
Option Explicit
Public WithEvents Btn As MSForms.CommandButton
Private label As String

Public Sub Init(ByVal button As MSForms.CommandButton, ByVal lbl As String)
    Set Btn = button
    label = lbl
End Sub

Private Sub Btn_Click()
    MsgBox "押された: " & label
End Sub
VB

フォーム起動時にイベント登録する

' FrmMain(ユーザーフォーム)
Option Explicit
Private btnEv As Collection

Private Sub UserForm_Initialize()
    Set btnEv = New Collection
    RegisterBtn Me.btnImport, "取込"
    RegisterBtn Me.btnExport, "出力"
End Sub

Private Sub RegisterBtn(ByVal b As MSForms.CommandButton, ByVal lbl As String)
    Dim ev As New CButtonEvents
    ev.Init b, lbl
    btnEv.Add ev
End Sub
VB

例題:入力検証はイベントで受付、本処理はサービスで高速配列I/O

受付は軽く、サービスへ委譲する

' CInputSheetEvents.cls(受付だけ)
Option Explicit
Public WithEvents Ws As Worksheet

Public Sub Init(ByVal target As Worksheet): Set Ws = target: End Sub

Private Sub Ws_Change(ByVal Target As Range)
    If Intersect(Target, Ws.Range("D:D")) Is Nothing Then Exit Sub
    If Not IsNumeric(Target.Value) Then
        Application.EnableEvents = False
        Target.Value = ""
        Application.EnableEvents = True
        MsgBox "数値を入力してください。", vbExclamation
        Exit Sub
    End If
    Run_RefreshSummary  ' 重い処理は入口Subへ
End Sub
VB
' ModService(本処理:配列I/Oで高速に)
Option Explicit

Public Sub Run_RefreshSummary()
    On Error GoTo EH
    AppEnter "集計更新"
    Dim arr As Variant: arr = Worksheets("Input").Range("A1").CurrentRegion.Value
    Dim rows As Long: rows = UBound(arr, 1)
    Dim idxScore As Long: idxScore = IndexByHeader(arr, "Score")

    Dim sum As Double, i As Long
    For i = 2 To rows: sum = sum + CDbl(arr(i, idxScore)): Next
    Worksheets("Summary").Range("B2").Value = sum

    AppLeave: Exit Sub
EH:
    AppLeave: MsgBox "失敗: " & Err.Description, vbExclamation
End Sub

Public Function IndexByHeader(ByVal data As Variant, ByVal name As String) As Long
    Dim j As Long
    For j = 1 To UBound(data, 2)
        If StrComp(CStr(data(1, j)), name, vbTextCompare) = 0 Then IndexByHeader = j: Exit Function
    Next
    Err.Raise 9100, , "ヘッダーがありません: " & name
End Function

Public Sub AppEnter(Optional ByVal status As String = "")
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    If Len(status) > 0 Then Application.StatusBar = status
End Sub

Public Sub AppLeave()
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
VB

安定運用の重要ポイント(深掘り)

再帰発火と暴走を止める

イベント内でセルを書き換えると、同じイベントが再発火します。書き換え前後を必ず EnableEvents=False/True で挟みます。例外時も確実にTrueへ戻すため、AppEnter/AppLeaveの枠を使うと安全です。

受付を軽く、本処理は分離して配列I/O

イベントは“トリガー”です。重い集計や出力は標準モジュールの入口Subに分離し、Range→配列→一括書き戻しの基本で高速化・安定化します。イベント内でDoEventsや長ループを回すのは避けます。

寿命管理と多重登録の抑止

WithEventsクラスのインスタンスは、コレクションやモジュール変数で保持して寿命を確保します。同じシートに二重でアタッチしないよう、Open時に一度だけ登録する設計にします。Close時(Workbook_BeforeClose)に参照を切るとクリーンです。


導入手順:今日からイベントクラスを適用する最短ルート

アプリイベントの集中管理を作る

CAppEventsを作り、Workbook_Openでインスタンスを保持します。受付だけ行い、重い処理は入口Subへ。

監視対象シートのイベントクラスを作る

CSheetEventsを用意し、ThisWorkbook.OpenでAttach。同じロジックを複数シートへ簡単に適用できます。

フォームやボタンのイベントをクラス化する

CButtonEventsを使い、フォーム初期化時にボタンへ登録。責務が読みやすくなり、増やしても壊れません。


まとめ:イベントは「受付」、本処理は「サービス」。クラスで境界を作れば強い

WithEventsでイベントをクラスへ集約し、EnableEvents制御と寿命管理で暴走を防ぐ。イベントは軽く、重い処理は配列I/Oのサービスへ委譲する——この境界があるだけで、Excelの現場は驚くほど安定します。

タイトルとURLをコピーしました