ray88’s diary

お仕事で困ったとき用の自分用の覚書

VBA クラスモジュール InitializeイベントとTerminateイベント

Initializeイベント:オブジェクトの初期化などインスタンスが生成されるときに必要な処理を記述する
Terminateイベント:インスタンスの破棄時に必要な処理を記述する

■サンプルコードの図解
f:id:ray88:20210508144000p:plain

■サンプルコード
 クラスモジュール(Customerクラスを利用してCustomersクラスを作成)

Option Explicit
'顧客情報セットのコレクション
Private myItems As Collection

'変数の初期化
Private Sub Class_Initialize()
    Set myItems = New Collection
End Sub

'変数の破棄
Private Sub Class_Terminate()
    Set myItems = Nothing
End Sub

'顧客情報を追加する
Public Sub Add(ByVal vID As String, ByVal vName As String, ByVal vAge As Integer, ByVal vGender As String)
    '顧客情報のセットであるCustomerクラスのオブジェクトを生成する
    Dim vCustomer As Customer
    Set vCustomer = New Customer
    
    'Customerオブジェクトに顧客情報を設定する
    With vCustomer
        .ID = vID
        .Name = vName
        .Age = vAge
        .Gender = vGender
    End With
    
    'コレクションに顧客情報セットを追加する
    myItems.Add vCustomer
    
    'Customerオブジェクトを初期化
    Set vCustomer = Nothing
    
End Sub

'顧客情報を取得する
Public Property Get Item(ByVal Index As Long) As Customer
    '顧客情報セットのコレクションmyItemよりアイテムのインデックス番号に紐づくデータを返す
    Set Item = myItems.Item(Index)
End Property

呼び出し元プロシージャ

Option Explicit
'表の列番号を定数化
Enum ColName
    ID = 1
    Name = 2
    Age = 3
    Gender = 4
End Enum
Sub テスト()

    '表データを格納する変数
     Dim TableValue As Variant
    '表最終行格納用変数
    Dim lngLastRow As Long

    '表データをバリアント型配列に格納
    With Worksheets("Sheet2")
        .Select
       lngLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
       TableValue = .Range(Cells(4, 2), Cells(lngLastRow, 5))
    End With
    
    '顧客情報のセットのコレクションであるCustomersクラスのオブジェクトを生成する
    Dim objCustomers As Customers
    Set objCustomers = New Customers
 
    '表データより顧客情報を取得しCustomerオブジェクトに値を設定
    Dim i As Long
    For i = LBound(TableValue) To UBound(TableValue)
            objCustomers.Add TableValue(i, ColName.ID), TableValue(i, ColName.Name), _
                             TableValue(i, ColName.Age), TableValue(i, ColName.Gender)
    Next
    
    '表から取得した顧客情報を抽出
    '(年齢18歳未満・性別規定値以外はCustomerクラスで設定したエラー値である-1を出力)
    For i = LBound(TableValue) To UBound(TableValue)
        Debug.Print objCustomers.Item(i).ID
        Debug.Print objCustomers.Item(i).Name
        Debug.Print objCustomers.Item(i).Age
        Debug.Print objCustomers.Item(i).Gender
        Debug.Print vbCrLf
    Next
    Set objCustomers = Nothing
End Sub

Sheet2の表を読み取ってイミディエイトウィンドウへ出力した結果
f:id:ray88:20210508190843p:plain

VBA クラスモジュール プロパティプロシージャ(Let と Get)

■クラスモジュール(Customerクラス)

Option Explicit
'モジュールレベル変数を宣言
Private cID As String   'ID
Private cName As String '氏名
Private cAge As Long    '年齢
Private cGender As Variant '性別

'IDを設定
Public Property Let ID(ByVal vID As String)
    cID = vID
End Property

'IDを出力
Public Property Get ID() As String
    ID = cID
End Property

'氏名を設定
Public Property Let Name(ByVal vName As String)
    cName = vName
End Property

'氏名を出力
Public Property Get Name() As String
    Name = cName
End Property

'年齢を設定
Public Property Let Age(ByVal vAge As Long)
    '18歳未満は受付不可の為、エラー判定値として-1を格納
    If vAge < 18 Then
        cAge = -1
    Else
        cAge = vAge
    End If
End Property

'年齢を出力
Public Property Get Age() As Long
    Age = cAge
End Property

'性別を取得
Public Property Let Gender(ByVal vGender As Variant)
    '「男」または「女」以外の値が入力された場合はエラー値として-1を格納
    If vGender = "男" Or vGender = "女" Then
            cGender = vGender
    Else
        cGender = -1
    End If
End Property

'性別を出力
Public Property Get Gender() As Variant
    Gender = cGender
End Property

■呼び出し元プロシージャ(標準モジュール)

Option Explicit

Sub test()
    'Customerクラスのオブジェクトを代入するの変数を宣言
    Dim objCustomer As Customer
    'Customerクラスのオブジェクトを生成
    Set objCustomer = New Customer
    'IDを設定
    objCustomer.ID = "A0001"
    '氏名を設定
    objCustomer.Name = "鈴木 太郎"
    '年齢を設定
    objCustomer.Age = 20
    '性別を設定
    objCustomer.Gender = "男"
    
    '顧客情報を出力
    Debug.Print objCustomer.ID
    Debug.Print objCustomer.Name
    If objCustomer.Age = -1 Then
        Debug.Print "18歳未満です"
    Else
        Debug.Print objCustomer.Age
    End If
    If objCustomer.Gender = -1 Then
        Debug.Print "規定値以外が入力されました"
    Else
        Debug.Print objCustomer.Gender
    End If
    
    Debug.Print vbCrLf
    
    'IDを設定
    objCustomer.ID = "A0002"
    '氏名を設定
    objCustomer.Name = "佐藤 太郎"
    '年齢を設定
    objCustomer.Age = 15
    '性別を設定
    objCustomer.Gender = "どちらでもない"
    
    '顧客情報を出力
    Debug.Print objCustomer.ID
    Debug.Print objCustomer.Name
    If objCustomer.Age = -1 Then
        Debug.Print "18歳未満です"
    Else
        Debug.Print objCustomer.Age
    End If
    If objCustomer.Gender = -1 Then
        Debug.Print "規定値以外が入力されました"
    Else
        Debug.Print objCustomer.Gender
    End If
    
    
End Sub

出力結果
f:id:ray88:20210508103436p:plain