VBA 自作クラスへのイベント実装例

自作クラスへのイベント実装例です。

ここでは爆弾クラスというのを作り、イベントの発生がどのように別クラスに作用するかを見ていきます。

爆弾クラスは「爆発イベント」を発生させるごとに自動車クラス、家クラスの現在価格を減額していきます。

かなり突飛な内容のサンプルですがイベントの動きを理解するのにはちょうどいいかと思って作成しました。

実務的には、例えはExcelなら「1シートに入力→別の複数シートにデータを反映」というようなときに使えます。

作成するクラスは下記の通りです。

なおCarClass、HouseClassと2つあるのは、一回のイベント発生で別クラス、複数インスタンスに作用するのを見るためにです。

クラス名	論理クラス名	役割	説明
BombClass	爆弾クラス	イベントが発生する	actionプロシージャの呼び出しによりexplodeイベントを発生させる。
CarClass	自動車クラス	発生したイベントを受け取る	BombClassのメンバ変数を持つ。 explodeイベントプロシージャを持つ。
HouseClass	家クラス

爆弾クラス(BombClass)

'爆弾クラス(BombClass)

Option Explicit

'爆発イベントの宣言
Public Event explode(damage As Long, count As Integer)

'メンバ変数 爆発回数記録
Private m_count As Integer

'爆発スイッチプロシージャ
Public Sub action(ByVal damage As Long)
    '爆発回数インクリメント
    m_count = m_count + 1

    '爆発イベントの発生
    RaiseEvent explode(damage, m_count)
End Sub

自動車クラス(CarClass)

'自動車クラス(CarClass)

Option Explicit

'イベントの発生するメンバ変数
Private WithEvents m_bomb As BombClass

'メンバ変数 所有者
Private m_owner As String
'メンバ変数 価格
Private m_value As Long

'プロパティプロシージャ
Property Set bomb(ByRef bomb As BombClass)
    '爆弾クラスのインスタンスを受け取る
    Set m_bomb = bomb
End Property

'所有者と価格を設定
Public Sub setOwner(name As String, value As Long)
    m_owner = name
    m_value = value
End Sub

'爆発イベントプロシージャ
Private Sub m_bomb_explode(damage As Long, count As Integer)
    m_value = m_value - damage
    Call MsgBox(m_owner & "さんの自動車が爆発した(" & CInt(count) & "回目)。現在価格：" & CStr(m_value))
End Sub

家クラス(HouseClass)

'家クラス(HouseClass)

Option Explicit

'イベントの発生するメンバ変数
Private WithEvents m_bomb As BombClass

'メンバ変数 所有者
Private m_owner As String
'メンバ変数 価格
Private m_value As Long

'プロパティプロシージャ
Property Set bomb(ByRef bomb As BombClass)
    '爆弾クラスのインスタンスを受け取る
    Set m_bomb = bomb
End Property

'所有者と価格を設定
Public Sub setOwner(name As String, value As Long)
    m_owner = name
    m_value = value
End Sub

'爆発イベントプロシージャ
Private Sub m_bomb_explode(damage As Long, count As Integer)
    m_value = m_value - damage
    Call MsgBox(m_owner & "さんの家が爆発した(" & CInt(count) & "回目)。現在価格：" & CStr(m_value))
End Sub

呼び出し側（ActiveXボタンを貼り付けてイベントプロシージャを記述）

Option Explicit

Public Sub CommandButton1_Click()
    '自動車クラスのインスタンスを生成
    Dim car1 As New CarClass
    '所有者と価格をセット
    Call car1.setOwner("太郎", 1000)
    
    '家クラスのインスタンスを生成
    Dim house1 As New HouseClass
    '所有者と価格をセット
    Call house1.setOwner("花子", 3500)
    
    '爆弾インスタンスを生成
    Dim myBomb As New BombClass
    
    '自動車クラスのインスタンスに爆弾をセット
    Set car1.bomb = myBomb
    '家クラスのインスタンスに爆弾をセット
    Set house1.bomb = myBomb
    
    '減少額を指定して爆発(1回目)
    Call myBomb.action(50)
    
    '減少額を指定して爆発(2回目)
    Call myBomb.action(250)
    
End Sub

ポイント

• イベントが発生するごとに、各インスタンスのイベントプロシージャが自動で呼ばれる。
• イベント発生とともに引数が渡せる。

VBAでのインターフェース実装例

■インターフェースの基本

VBAでのインターフェース実装例と使い方の例です。

Englishクラス、Japaneseクラスは別クラスでありながら、sayサブルーチンにインスタンスを渡すことができ、さらにgreetingを実行した時はそれぞれの実装で処理されるのがミソです。

（なおVBAではインターフェースモジュールというのはないので、クラスモジュールを使います。）

IPersonインターフェース

'IPersonインターフェース

'挨拶を返すプロシージャ
Public Function greeting() As String
End Function

Englishクラス

'IPersonインターフェースを実装したEnglish具象クラス
Implements IPerson
Public Function IPerson_greeting() As String
    IPerson_greeting = "Hello."
End Function

Japaneseクラス

'IPersonインターフェースを実装したJapanese具象クラス
Implements IPerson
Public Function IPerson_greeting() As String
    IPerson_greeting = "こんにちは。"
End Function

呼び出し側（ActiveXボタンを貼り付けてイベントプロシージャを記述）

Private Sub CommandButton1_Click()
    '具象クラスの変数を宣言
    Dim person1 As New English
    Dim person1 As New Japanese
    
    'インスタンスをsayサブルーチンに渡す
    Call say(person1)
    Call say(person2)
End Sub

'挨拶を表示させるサブルーチン
Private Sub say(ByRef arg As IPerson)
    'sayサブルーチンは具象クラスが何であるかを知ることなく、greetingを呼び出す。
    Call MsgBox(arg.greeting)
End Sub

■イテレータの実装

インターフェースを利用してイテレータ機能を実現します。

IIteratorインターフェース

'イテレータインターフェース

'次の要素がある場合にtrueを返す
Public Function hasNext() As Boolean
End Function

'次の要素を返す。
Public Function getNext() As Variant
End Function

mySetクラス

'イテレータインターフェースを実装したmyData具象クラス
Implements IIterator

'反復処理中のインデックス
Private index As Integer

'保持している配列
Private myData As Variant

'配列変数を受け取ってセットする。
Public Sub setData(ByRef arg As Variant)
    index = 0
    myData = arg
End Sub

'次の要素がある場合にtrueを返す。
Public Function IIterator_hasNext() As Boolean
    IIterator_hasNext = index <= UBound(myData)
End Function

'次の要素を返す。
Public Function IIterator_getNext() As Variant
    IIterator_getNext = myData(index)
    index = index + 1
End Function

呼び出し側（ActiveXボタンを貼り付けてイベントプロシージャを記述）

Private Sub CommandButton1_Click()
    'MySetのインスタンスを作成
    Dim myData As MySet
    Set myData = New MySet
    'データをセット
    Call myData.setData(Array("aa", "bb", "cc"))
    
    'イテレータインターフェースで宣言し、MySetのインスタンスを代入
    '（myData.hasNextができないためこのようにします）
    Dim myItr As IIterator
    Set myItr = myData
    
    'イテレータによるデータの取り出し
    While myItr.hasNext
        Call MsgBox(CStr(myItr.getNext))
    Wend
End Sub

VBA覚書 Dimステートメントについて

以下のコードを実行したとき、cntは初回のDimを通った時は初期値を持つが、
2回目以降は前回の値を保持したまま。つまりDimを通っても初期化されない。
JavaでいうFor文の{}内スコープの感覚で「初期化されるだろう」と勘違いして躓いた。

Dim i As Integer
For i = 1 To 5
    Dim cnt As Integer
    cnt = cnt + 1
    Debug.Print cnt
Next

ちなみに、リファレンスでは「プロシージャで Dim ステートメントを使用するとき、通常、 Dim ステートメントをプロシージャの最初に配置します。」との但し書きがある。（プロトタイプ宣言の様な書き方は前世代的な感じもするが）
ただ、少なくともVBAに関してはFor内のDimの使用は混乱のもとなので今後はやめようと思う。

■Dim ステートメント

'固定長配列(メモリ確保する)。

Dim foo(10) As Integer

typeを省略するとVariantとなる。なお、For Each文を使う場合は必ずVariantにする必要あり。

指定する値は添え字の最大値(※要素数ではない！ここが他の言語と違う)。

10を指定した場合は0から10までの「11個の要素」を確保する。

添え字の下限値を指定したい場合は以下のようにする(1以上も可能)。

Dim foo(5 to 10) As Integer

'可変長配列(メモリ確保しない)。
Dim foo() As Integer

使用するにはこの後かならずReDimでメモリの確保をする必要あり。

■Dim ステートメントのNewの扱い

Setステートメントを省略するためのものではない。「最初の参照でオブジェクトの新しいインスタンスが作成される」のであって、宣言と同時にインスタンスが作成されるわけではない。

■ReDim ステートメント
Dimではメモリ確保の際に動的な値を指定できないため、ユーザ入力値など可変の配列を確保したい場合はReDimを使う。
ReDim foo(動的な値) As Integer
既存の値を保持したまま添え字の最大値を変更する場合はPreserve を付ける。
ReDim Preserve foo(動的な値)

■Erase ステートメント
固定長配列の場合
　各要素を初期化する。
可変長配列の場合
　メモリを解放する。次回使用するには必ずReDimする必要あり。
Erase arraylist

■Option Base ステートメント
配列の添字の既定の下限(0 or 1)を宣言する(モジュール単位)
Option Base 0

■UBound 関数/LBound 関数
最大/最小の添え字をLongで返す。
メモリが確保されてない可変長配列を指定するとエラーとなる。

Microsoft VBA 言語リファレンス
https://msdn.microsoft.com/ja-jp/vba/language-reference-vba/articles/dim-statement
https://msdn.microsoft.com/ja-jp/vba/language-reference-vba/articles/redim-statement
https://msdn.microsoft.com/ja-jp/vba/language-reference-vba/articles/erase-statement
https://msdn.microsoft.com/ja-jp/vba/language-reference-vba/articles/option-base-statement