'要素を追加するメソッド
Public Function itemAdd(ByVal rng As Range) As Class1
Dim owner As Class1
Dim res As Integer
'追加要素の各プロパティ設定用メソッドへ
Set owner = New Class1: owner.Init1 rng
Set owner.Pet = New Class1: owner.Pet.Init2 rng
Re:
On Error Resume Next
'コレクションに追加要素のインスタンスを追加
mycol.Add owner, owner.ID
'Key重複はエラーで登録できない旨メッセージする
If Err.Number <> 0 Then
res = MsgBox("""" & owner.ID & """" & _
"は重複しています!上書きしますか?" _
, vbOKCancel)
Err.Clear
If res = vbOK Then
'上書の場合は元Itemは削除して再設定する
itemRemove (owner.ID): GoTo Re
End If
End If
End Function
【コード補足】
2行目、引数は Range オブジェクトにしています。理由はシートの表データをインスタンス化する際にRangeオブジェクトを使ったからです。型が同じなら変換の必要が無いので(^^;
'標準モジュール
Sub rngCollectionTest()
Dim table As clsCol
'インスタンス作成⇒コンストラクタ起動
Set table = New clsCol
'コレクションに要素を追加する
Call ColAddItem(table)
End Sub
次のプロシージャを Call して呼び出す設定です。
コレクションに新たな要素を追加するプロシージャ
'コレクションに要素を追加する
Sub ColAddItem(ByVal table As clsCol)
Dim item As Class1
Dim rng As Range
Dim r As Long, c As Long
redo:
On Error Resume Next
Set rng = Application.InputBox(Prompt:= _
"追加要素のKeyセルを単一で選択してください!", _
Title:="追加要素を指定", Type:=8)
On Error GoTo 0
If rng Is Nothing Then Exit Sub
'選択されたセルが単一かを判定
If rng.Cells.Count = 1 Then
r = rng.Row '選択セルの行番号
c = rng.Column '選択セルの列番号
Set rng = Range(Cells(r, c), Cells(r, c + 6))
Set item = table.itemAdd(rng)
Else
MsgBox "セルの選択が単一ではありません!" & _
vbCrLf & "もう一度選択し直してください。"
GoTo redo
End If
End Sub