'ownerのコンストラクタ直後に各プロパティを設定用
Public Function Init1(ByVal rng As Range) As Class1
Set Init1 = Me '自分自身を返す
With Me
.ID = rng(1).Value 'IDに代入
.Name = rng(2).Value 'Nameに代入
.Age = rng(3).Value 'Ageに代入
End With
End Function
'owner.Petのコンストラクタ直後に各プロパティを設定用
Public Function Init2(ByVal rng As Range) As Class1
Set Init2 = Me '自分自身を返す
With Me
.Name = rng(4).Value 'owner.PetのNameに代入
.Age = rng(5).Value 'owner.PetのAgeに代入
.Types = rng(6).Value 'owner.PetのTipesに代入
.Gender = rng(7).Value 'owner.PetのGenderに代入
End With
End Function
元の標準モジュールからコードを移植しています。
Rangeオブジェクトにしないと、引数で渡すには都合が悪いのでその部分は変更しています。
コンストラクタ直後にメソッド実行
標準モジュール側のコードがこちらです。
Option Explicit
'標準モジュール
Sub rngCollectionTest()
'変数宣言
Dim owner As Class1 'ownerクラスインスタンス用
Dim rng As Range 'Rangeオブジェクト用
'コレクションオブジェクト作成
Dim mycol As Collection: Set mycol = New Collection
Dim i As Long: i = 4 'ループ処理用:初期値4
With Sheet1
Do While .Cells(i, 1).Value <> ""
Set rng = .Range(.Cells(i, 1), .Cells(i, 7))
'インスタンス作成:引数付きメソッドで値代入
Set owner = New Class1: owner.Init1 rng
Set owner.Pet = New Class1: owner.Pet.Init2 rng
'コレクションに書き込む
mycol.Add owner, owner.ID
i = i + 1
Loop
End With
'確認用にメッセージを表示
For i = 4 To i - 1
With mycol.Item(i - 3)
MsgBox "OWNER：" & .Name & "(" & .Age & "歳)" _
& vbCrLf & "ペット名：" & .Pet.Name & _
"(" & .Pet.Age & "歳)" & .Pet.Types & _
"/" & .Pet.Gender
End With
Next
Set mycol = Nothing 'コレクション開放
End Sub
Option Explicit
'コレクション用変数
Public mycol As Collection
'コンストラクタ
Private Sub Class_Initialize()
'変数宣言
Dim owner As Class1 '別クラス呼び出し用
Dim rng As Range
Dim i As Long: i = 4
'コレクション初期化
If mycol Is Nothing Then Set mycol = New Collection
'Sheet1の表データからプロパティ値取得
With Sheet1
Do While .Cells(i, 1).Value <> ""
Set rng = .Range(.Cells(i, 1), .Cells(i, 7))
Set owner = New Class1: owner.Init1 rng
Set owner.Pet = New Class1: owner.Pet.Init2 rng
'コレクションに書き込む
mycol.Add owner, owner.ID
i = i + 1
Loop
End With
End Sub
'デストラクタ
Private Sub Class_Terminate()
'ここでコレクションオブジェクトを解放
If Not (mycol Is Nothing) Then Set mycol = Nothing
End Sub
