VBA 自作クラスのBeforeChangeイベントでCancel処理をする方法

さて、前回は自作クラスにEventを実装する方法について説明した。
thom.hateblo.jp

前回紹介したマクロはMoveNextをクリックするたびにカーソルが下に移動するというものだったが、CursorオブジェクトのValueに上限・下限を設けていないためクリックし続けるとEOFをはみ出してもカーソルが進むことができてしまう。

まずクラスモジュール「Cursor」を次のように変更する。

Private innerValue As Long
Public Event Change(current As Long, previous As Long)
Public Event BeforeChange(e As Long, Cancel As Boolean)

Sub Init(n As Long)
    innerValue = n
End Sub

Property Get Value() As Long
    Value = innerValue
End Property

Property Let Value(n As Long)
    Dim c As Boolean
    RaiseEvent BeforeChange(n, c)
    If c Then Exit Property
    
    Dim pv As Long: pv = innerValue
    innerValue = n
    RaiseEvent Change(innerValue, pv)
End Property

Sub MoveNext()
    Value = innerValue + 1
End Sub
Sub MovePrevious()
    Value = innerValue - 1
End Sub

変更点としてはまず、BeforeChangeイベントの宣言だ。

Public Event BeforeChange(e As Long, Cancel As Boolean)

このイベントが発動されると、仮引数eとCancelに値が渡される。
ちなみにeはEventArgsのe。ArgsというのはArgumentsの略で、つまり引数のことである。
VB.NetにはEventArgs型があるので通常「e As EventArgs」などと書くが、VBAにそんなものはないのでただのLong型である。
この引数名はeじゃなくてnextValueなど、その働きがわかる名前にしようか迷ったけど、nextとすると増加のイメージがあるのであえて単にEventArgsの頭文字を使用した。

この仮引数eには変更予定の数値が渡されることを想定している。

もうひとつの仮引数 Cancel はBoolean型の変数を参照渡しすることを想定している。
のちほど詳しく動作を説明するので今の説明でよくわからなかった方は気にせず次に進んでほしい。

Cursorクラスの2つ目の変更点はValueプロパティのLet部に追記した以下の3行。

Dim c As Boolean
RaiseEvent BeforeChange(n, c)
If c Then Exit Property

Boolean型の変数cをイベントプロシージャの仮引数に参照渡しするので、イベントプロシージャ側でCancelにTrueが代入されたら次のIf文でPropertyをExitする。つまりこの場合、実際のValueの変更は起こらないということ。

さて、次はSheet1モジュール。
全体コードは以下のように変更する。

Private WithEvents Cur As Cursor

Sub 初期化_Clicked()
    Set Cur = New Cursor
    Cur.Init 3
    Range("B3").Value = "▲"
End Sub

Sub MoveNext_Clicked()
    Cur.MoveNext
End Sub

Sub MovePrevious_Clicked()
    Cur.MovePrevious
End Sub

Private Sub Cur_BeforeChange(e As Long, Cancel As Boolean)
    If e < 3 Or e > 12 Then
        Cancel = True
        MsgBox "カーソル範囲を超えています。", vbExclamation, "エラー"
    End If
End Sub

Private Sub Cur_Change(current As Long, previous As Long)
    Range("B" & previous).ClearContents
    Range("B" & current).Value = "▲"
End Sub

変更点は、Cur_BeforeChangeプロシージャが増えたことである。
まず仮引数eで変更予定の値を受けとり、これが3未満か12超だったらCancelにTrueを代入し、エラーメッセージを表示させる。

Private Sub Cur_BeforeChange(e As Long, Cancel As Boolean)
    If e < 3 Or e > 12 Then
        Cancel = True
        MsgBox "カーソル範囲を超えています。", vbExclamation, "エラー"
    End If
End Sub

3未満か12超だったらというのはこういうこと。
f:id:t-hom:20161013201139p:plain

前回紹介した図を思い出すと、イベントプロシージャが終わったらまたCursorモジュールに制御が戻ることになる。
f:id:t-hom:20161013000607p:plain

※図は使い回しなのでCur_Changeがコールバックされているが、今回はCur_Changeの前にCur_BeforeChangeが呼ばれる。

ここで今一度Cancelがどこから来たのか思い出してほしい。
そう、これはCursorモジュールのRaiseEventでBoolea型の変数cが、参照渡しされたものである。だからSheet1モジュールでCancelをTrueにすると、Cursorモジュールに制御が戻った際に変数cがTrueになっているということだ。
するとCursorモジュールの「If c Then Exit Property」でプロパティプロシージャが終了するので実際の値は変更されない。

このようにBeforeChangeイベントによってカーソルが所定の範囲からはみ出ようとするのを監視し、Changeをキャンセルすることができる。

さて、このキャンセル処理、どこかで見覚えはないだろうか。
実は、Thisworkbookに記述するBefore系イベントに、Cancelが使用されているのだ。

Private Sub Workbook_BeforeClose(Cancel As Boolean)

End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)

End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

End Sub