スキルアップ・問題解決なら、モーグにおまかせ！

前スレッドはこちらです。
http://www.moug.net/faq/viewtopic.php?t=62306
 
引き続きよろしくお願い致します。
（急いで打っているもので気の利いた事を書けなくすみません^^）

別プロジェクトのクラスの利用
 
別プロジェクトのクラスの利用について調べると以下のことがわかります。
・別プロジェクトのクラスはPublicなのかPrivateかに関係なくNew指定でインスタンスを生成できません。
・別プロジェクトのクラスのインスタンスを生成する場合は、クラスが存在するプロジェクト内に標準モジュールでコンストラクタ相当のプロシージャを作成してそれを呼び出す必要があります。
・別プロジェクトのPrivateなクラスは、そのクラス名を型にした変数は使用できません。
・別プロジェクトのPrivateなクラスを使用するときは、変数の型はObjectにしなければいけません。
・PublicなクラスのPublicプロパティとして、Privateなクラスを指定できません。
・PublicなクラスのPublicプロパティとして、Privateなクラスを指定する場合は、Private変数とPropertyプロシージャを使って外部にはObject型のプロパティにします。
 
別プロジェクトから利用されるクラスはPublicにして、そのクラスがPublicプロパティで公開するクラスもPublicにしたほうがいいでしょう。
Privateなクラスのままでも別プロジェクトからはObject型で利用できますが、Object型になってしまうとプロパティやメソッドの指定に誤りがあってもコンパイルエラーにあなりません。またVBエディターのメンバ表示機能も使用できません。
 
調査に使ったコードは以下のとおりです。
 
 
●PrjB.xls
VBプロジェクト名 PrjB

'*** クラス clsA1Pub ***
'* instancing = PublicNotCreatable
Option Explicit
Public StrA1Pub As String
Public obj2 As clsA2Pub

'*** クラス clsA2Pub ***
'* instancing = PublicNotCreatable
Option Explicit
Public StrA2Pub As String

'*** クラス clsB1Pub ***
'* instancing = PublicNotCreatable
Option Explicit
Public StrB1Pub As String
'* PublicなクラスのPublicなプロパティの型に
'* Privateなクラスは指定できない。
'Public Obj2 As clsB2Prv 'NG
Private mobjObj2 As clsB2Prv
'* PublicなクラスのPublicなプロパティの型に
'* Privateなクラスは指定できない。
'Public Property Get Obj2() As clsB2Prv 'NG
'End Property
'Public Property Set Obj2(p1 As clsB2Prv) 'NG
'End Property
Public Property Get obj2() As Object
    Set obj2 = mobjObj2
End Property
Public Property Set obj2(p1 As Object)
    Set mobjObj2 = p1
End Property

'*** クラス clsB2Prv ***
'* instancing = Private
Option Explicit
Public StrB2Prv As String

'*** クラス clsC1Prv ***
'* instancing = Private
Option Explicit
Public StrC1Prv As String
Public obj2 As clsC2Pub

'*** クラス clsC2Pub ***
'* instancing = PublicNotCreatable
Option Explicit
Public StrC2Pub As String

'*** クラス clsD1Prv ***
'* instancing = Private
Option Explicit
Public StrD1Prv As String
Public obj2 As clsD2Prv

'*** クラス clsD2Prv ***
'* instancing = Private
Option Explicit
Public StrD2Prv As String

'*** 標準モジュール modA1Pub ***
Option Explicit
Public Function Init1() As clsA1Pub
    Dim obj1 As clsA1Pub
    Set obj1 = New clsA1Pub
    Set obj1.obj2 = modA2Pub.Init1
    Set Init1 = obj1
End Function

'*** 標準モジュール modA2Pub ***
Option Explicit
Public Function Init1() As clsA2Pub
    Dim obj1 As clsA2Pub
    Set obj1 = New clsA2Pub
    Set Init1 = obj1
End Function

'*** 標準モジュール modB1Pub ***
Option Explicit
Public Function Init1() As clsB1Pub
    Dim obj1 As clsB1Pub
    Set obj1 = New clsB1Pub
    Set obj1.obj2 = modB2Prv.Init1
    Set Init1 = obj1
End Function

'*** 標準モジュール modB2Prv ***
Option Explicit
'* 標準モジュールではPublicプロシージャの戻り値
'* の型にPrivateなクラスを指定できる。
Public Function Init1() As clsB2Prv
    Dim obj1 As clsB2Prv
    Set obj1 = New clsB2Prv
    Set Init1 = obj1
End Function

'*** 標準モジュール modC1Prv ***
Option Explicit
'* 標準モジュールではPublicプロシージャの戻り値
'* の型にPrivateなクラスを指定できる。
Public Function Init1() As clsC1Prv
    Dim obj1 As clsC1Prv
    Set obj1 = New clsC1Prv
    Set obj1.obj2 = modC2Pub.Init1
    Set Init1 = obj1
End Function

'*** 標準モジュール modC2Pub ***
Option Explicit
Public Function Init1() As clsC2Pub
    Dim obj1 As clsC2Pub
    Set obj1 = New clsC2Pub
    Set Init1 = obj1
End Function

'*** 標準モジュール modD1Prv ***
Option Explicit
'* 標準モジュールではPublicプロシージャの戻り値
'* の型にPrivateなクラスを指定できる。
Public Function Init1() As clsD1Prv
    Dim obj1 As clsD1Prv
    Set obj1 = New clsD1Prv
    Set obj1.obj2 = modD2Prv.Init1
    Set Init1 = obj1
End Function

'*** 標準モジュール modD2Prv ***
Option Explicit
Public Function Init1() As clsD2Prv
    Dim obj1 As clsD2Prv
    Set obj1 = New clsD2Prv
    Set Init1 = obj1
End Function

'*** 標準モジュール modTest1 ***
'* 親クラスのインスタンス生成時に
'* 子クラスのインスタンスも生成１。
'* 変数の型はクラス名。
Option Explicit
Sub Test11()
    Dim obj1 As clsA1Pub
    Set obj1 = modA1Pub.Init1
    obj1.StrA1Pub = "1"
    obj1.obj2.StrA2Pub = "2"
    Debug.Print obj1.StrA1Pub
    Debug.Print obj1.obj2.StrA2Pub
End Sub
Sub Test12()
    Dim obj1 As clsB1Pub
    Set obj1 = modB1Pub.Init1
    obj1.StrB1Pub = "3"
    obj1.obj2.StrB2Prv = "4"
    Debug.Print obj1.StrB1Pub
    Debug.Print obj1.obj2.StrB2Prv
End Sub
Sub Test13()
    Dim obj1 As clsC1Prv
    Set obj1 = modC1Prv.Init1
    obj1.StrC1Prv = "5"
    obj1.obj2.StrC2Pub = "6"
    Debug.Print obj1.StrC1Prv
    Debug.Print obj1.obj2.StrC2Pub
End Sub
Sub Test14()
    Dim obj1 As clsD1Prv
    Set obj1 = modD1Prv.Init1
    obj1.StrD1Prv = "7"
    obj1.obj2.StrD2Prv = "8"
    Debug.Print obj1.StrD1Prv
    Debug.Print obj1.obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest2 ***
'* 親クラスのインスタンス生成時に
'* 子クラスのインスタンスも生成１。
'* 変数の型はObject。
Option Explicit
Sub Test21()
    Dim obj1 As Object
    Set obj1 = modA1Pub.Init1
    obj1.StrA1Pub = "1"
    obj1.obj2.StrA2Pub = "2"
    Debug.Print obj1.StrA1Pub
    Debug.Print obj1.obj2.StrA2Pub
End Sub
Sub Test22()
    Dim obj1 As Object
    Set obj1 = modB1Pub.Init1
    obj1.StrB1Pub = "3"
    obj1.obj2.StrB2Prv = "4"
    Debug.Print obj1.StrB1Pub
    Debug.Print obj1.obj2.StrB2Prv
End Sub
Sub Test23()
    Dim obj1 As Object
    Set obj1 = modC1Prv.Init1
    obj1.StrC1Prv = "5"
    obj1.obj2.StrC2Pub = "6"
    Debug.Print obj1.StrC1Prv
    Debug.Print obj1.obj2.StrC2Pub
End Sub
Sub Test24()
    Dim obj1 As Object
    Set obj1 = modD1Prv.Init1
    obj1.StrD1Prv = "7"
    obj1.obj2.StrD2Prv = "8"
    Debug.Print obj1.StrD1Prv
    Debug.Print obj1.obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest3 ***
'* 子クラスのインスタンスを直接生成１。
'* 変数の型はクラス名
Option Explicit
Sub Test31()
    Dim obj2 As clsA2Pub
    Set obj2 = modA2Pub.Init1
    obj2.StrA2Pub = "1"
    Debug.Print obj2.StrA2Pub
End Sub
Sub Test32()
    Dim obj2 As clsB2Prv
    Set obj2 = modB2Prv.Init1
    obj2.StrB2Prv = "2"
    Debug.Print obj2.StrB2Prv
End Sub
Sub Test33()
    Dim obj2 As clsC2Pub
    Set obj2 = modC2Pub.Init1
    obj2.StrC2Pub = "3"
    Debug.Print obj2.StrC2Pub
End Sub
Sub Test34()
    Dim obj2 As clsD2Prv
    Set obj2 = modD2Prv.Init1
    obj2.StrD2Prv = "4"
    Debug.Print obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest4 ***
'* 子クラスのインスタンスを直接生成２。
'* 変数の型はObject。
Option Explicit
Sub Test41()
    Dim obj2 As Object
    Set obj2 = modA2Pub.Init1
    obj2.StrA2Pub = "1"
    Debug.Print obj2.StrA2Pub
End Sub
Sub Test42()
    Dim obj2 As Object
    Set obj2 = modB2Prv.Init1
    obj2.StrB2Prv = "2"
    Debug.Print obj2.StrB2Prv
End Sub
Sub Test43()
    Dim obj2 As Object
    Set obj2 = modC2Pub.Init1
    obj2.StrC2Pub = "3"
    Debug.Print obj2.StrC2Pub
End Sub
Sub Test44()
    Dim obj2 As Object
    Set obj2 = modD2Prv.Init1
    obj2.StrD2Prv = "4"
    Debug.Print obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest5 ***
'* 親クラスのインスタンス生成時に生成した
'* 子クラスのインスタンスを変数に代入１。
'* 親クラスの変数の型はクラス名。
'* 子クラスの変数の型はクラス名。
Option Explicit
Sub Test51()
    Dim obj1 As clsA1Pub
    Dim obj2 As clsA2Pub
    Set obj1 = modA1Pub.Init1
    Set obj2 = obj1.obj2
    obj2.StrA2Pub = "1"
    Debug.Print obj2.StrA2Pub
End Sub
Sub Test52()
    Dim obj1 As clsB1Pub
    Dim obj2 As clsB2Prv
    Set obj1 = modB1Pub.Init1
    Set obj2 = obj1.obj2
    obj2.StrB2Prv = "2"
    Debug.Print obj2.StrB2Prv
End Sub
Sub Test53()
    Dim obj1 As clsC1Prv
    Dim obj2 As clsC2Pub
    Set obj1 = modC1Prv.Init1
    Set obj2 = obj1.obj2
    obj2.StrC2Pub = "3"
    Debug.Print obj2.StrC2Pub
End Sub
Sub Test54()
    Dim obj1 As clsD1Prv
    Dim obj2 As clsD2Prv
    Set obj1 = modD1Prv.Init1
    Set obj2 = obj1.obj2
    obj2.StrD2Prv = "4"
    Debug.Print obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest6 ***
'* 親クラスのインスタンス生成時に生成した
'* 子クラスのインスタンスを変数に代入２。
'* 親クラスの変数の型はクラス名。
'* 子クラスの変数の型はObject。
Option Explicit
Sub Test61()
    Dim obj1 As clsA1Pub
    Dim obj2 As Object
    Set obj1 = modA1Pub.Init1
    Set obj2 = obj1.obj2
    obj2.StrA2Pub = "1"
    Debug.Print obj2.StrA2Pub
End Sub
Sub Test62()
    Dim obj1 As clsB1Pub
    Dim obj2 As Object
    Set obj1 = modB1Pub.Init1
    Set obj2 = obj1.obj2
    obj2.StrB2Prv = "2"
    Debug.Print obj2.StrB2Prv
End Sub
Sub Test63()
    Dim obj1 As clsC1Prv
    Dim obj2 As Object
    Set obj1 = modC1Prv.Init1
    Set obj2 = obj1.obj2
    obj2.StrC2Pub = "3"
    Debug.Print obj2.StrC2Pub
End Sub
Sub Test64()
    Dim obj1 As clsD1Prv
    Dim obj2 As Object
    Set obj1 = modD1Prv.Init1
    Set obj2 = obj1.obj2
    obj2.StrD2Prv = "4"
    Debug.Print obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest7 ***
'* 親クラスのインスタンス生成時に生成した
'* 子クラスのインスタンスを変数に代入３。
'* 親クラスの変数の型はObject。
'* 子クラスの変数の型はクラス名。
Option Explicit
Sub Test71()
    Dim obj1 As Object
    Dim obj2 As clsA2Pub
    Set obj1 = modA1Pub.Init1
    Set obj2 = obj1.obj2
    obj2.StrA2Pub = "1"
    Debug.Print obj2.StrA2Pub
End Sub
Sub Test72()
    Dim obj1 As Object
    Dim obj2 As clsB2Prv
    Set obj1 = modB1Pub.Init1
    Set obj2 = obj1.obj2
    obj2.StrB2Prv = "2"
    Debug.Print obj2.StrB2Prv
End Sub
Sub Test73()
    Dim obj1 As Object
    Dim obj2 As clsC2Pub
    Set obj1 = modC1Prv.Init1
    Set obj2 = obj1.obj2
    obj2.StrC2Pub = "3"
    Debug.Print obj2.StrC2Pub
End Sub
Sub Test74()
    Dim obj1 As Object
    Dim obj2 As clsD2Prv
    Set obj1 = modD1Prv.Init1
    Set obj2 = obj1.obj2
    obj2.StrD2Prv = "4"
    Debug.Print obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest8 ***
'* 親クラスのインスタンス生成時に生成した
'* 子クラスのインスタンスを変数に代入４。
'* 親クラスの変数の型はObject。
'* 子クラスの変数の型はObject。
Option Explicit
Sub Test81()
    Dim obj1 As Object
    Dim obj2 As Object
    Set obj1 = modA1Pub.Init1
    Set obj2 = obj1.obj2
    obj2.StrA2Pub = "1"
    Debug.Print obj2.StrA2Pub
End Sub
Sub Test82()
    Dim obj1 As Object
    Dim obj2 As Object
    Set obj1 = modB1Pub.Init1
    Set obj2 = obj1.obj2
    obj2.StrB2Prv = "2"
    Debug.Print obj2.StrB2Prv
End Sub
Sub Test83()
    Dim obj1 As Object
    Dim obj2 As Object
    Set obj1 = modC1Prv.Init1
    Set obj2 = obj1.obj2
    obj2.StrC2Pub = "3"
    Debug.Print obj2.StrC2Pub
End Sub
Sub Test84()
    Dim obj1 As Object
    Dim obj2 As Object
    Set obj1 = modD1Prv.Init1
    Set obj2 = obj1.obj2
    obj2.StrD2Prv = "4"
    Debug.Print obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest1 ***
'* 親クラスのインスタンス生成時に
'* 子クラスのインスタンスも生成１。
'* 変数の型はクラス名。
Option Explicit
Sub Test11()
    Dim obj1 As clsA1Pub
    Set obj1 = modA1Pub.Init1
    obj1.StrA1Pub = "1"
    obj1.obj2.StrA2Pub = "2"
    Debug.Print obj1.StrA1Pub
    Debug.Print obj1.obj2.StrA2Pub
End Sub
Sub Test12()
    Dim obj1 As clsB1Pub
    Set obj1 = modB1Pub.Init1
    obj1.StrB1Pub = "3"
    obj1.obj2.StrB2Prv = "4"
    Debug.Print obj1.StrB1Pub
    Debug.Print obj1.obj2.StrB2Prv
End Sub
Sub Test13()
'    '別プロジェクトのPrivateなクラスは使用できない
'    Dim obj1 As clsC1Prv 'NG
'    Set obj1 = modC1Prv.Init1
'    obj1.StrC1Prv = "5"
'    obj1.obj2.StrC2Pub = "6"
'    Debug.Print obj1.StrC1Prv
'    Debug.Print obj1.obj2.StrC2Pub
End Sub
Sub Test14()
'    '別プロジェクトのPrivateなクラスは使用できない
'    Dim obj1 As clsD1Prv 'NG
'    Set obj1 = modD1Prv.Init1
'    obj1.StrD1Prv = "7"
'    obj1.obj2.StrD2Prv = "8"
'    Debug.Print obj1.StrD1Prv
'    Debug.Print obj1.obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest2 ***
'* 親クラスのインスタンス生成時に
'* 子クラスのインスタンスも生成２。
'* 変数の型はObject。
Option Explicit
Sub Test21()
    Dim obj1 As Object
    Set obj1 = modA1Pub.Init1
    obj1.StrA1Pub = "1"
    obj1.obj2.StrA2Pub = "2"
    Debug.Print obj1.StrA1Pub
    Debug.Print obj1.obj2.StrA2Pub
End Sub
Sub Test22()
    Dim obj1 As Object
    Set obj1 = modB1Pub.Init1
    obj1.StrB1Pub = "3"
    obj1.obj2.StrB2Prv = "4"
    Debug.Print obj1.StrB1Pub
    Debug.Print obj1.obj2.StrB2Prv
End Sub
Sub Test23()
    Dim obj1 As Object
    Set obj1 = modC1Prv.Init1
    obj1.StrC1Prv = "5"
    obj1.obj2.StrC2Pub = "6"
    Debug.Print obj1.StrC1Prv
    Debug.Print obj1.obj2.StrC2Pub
End Sub
Sub Test24()
    Dim obj1 As Object
    Set obj1 = modD1Prv.Init1
    obj1.StrD1Prv = "7"
    obj1.obj2.StrD2Prv = "8"
    Debug.Print obj1.StrD1Prv
    Debug.Print obj1.obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest3 ***
'* 子クラスのインスタンスを直接生成１。
'* 変数の型はクラス名
Option Explicit
Sub Test31()
    Dim obj2 As clsA2Pub
    Set obj2 = modA2Pub.Init1
    obj2.StrA2Pub = "1"
    Debug.Print obj2.StrA2Pub
End Sub
Sub Test32()
'    '別プロジェクトのPrivateなクラスは使用できない
'    Dim obj2 As clsB2Prv 'NG
'    Set obj2 = modB2Prv.Init1
'    obj2.StrB2Prv = "2"
'    Debug.Print obj2.StrB2Prv
End Sub
Sub Test33()
    Dim obj2 As clsC2Pub
    Set obj2 = modC2Pub.Init1
    obj2.StrC2Pub = "3"
    Debug.Print obj2.StrC2Pub
End Sub
Sub Test34()
'    '別プロジェクトのPrivateなクラスは使用できない
'    Dim obj2 As clsD2Prv 'NG
'    Set obj2 = modD2Prv.Init1
'    obj2.StrD2Prv = "4"
'    Debug.Print obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest4 ***
'* 子クラスのインスタンスを直接生成２。
'* 変数の型はObject。
Option Explicit
Sub Test41()
    Dim obj2 As Object
    Set obj2 = modA2Pub.Init1
    obj2.StrA2Pub = "1"
    Debug.Print obj2.StrA2Pub
End Sub
Sub Test42()
    Dim obj2 As Object
    Set obj2 = modB2Prv.Init1
    obj2.StrB2Prv = "2"
    Debug.Print obj2.StrB2Prv
End Sub
Sub Test43()
    Dim obj2 As Object
    Set obj2 = modC2Pub.Init1
    obj2.StrC2Pub = "3"
    Debug.Print obj2.StrC2Pub
End Sub
Sub Test44()
    Dim obj2 As Object
    Set obj2 = modD2Prv.Init1
    obj2.StrD2Prv = "4"
    Debug.Print obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest5 ***
'* 親クラスのインスタンス生成時に生成した
'* 子クラスのインスタンスを変数に代入１。
'* 親クラスの変数の型はクラス名。
'* 子クラスの変数の型はクラス名。
Option Explicit
Sub Test51()
    Dim obj1 As clsA1Pub
    Dim obj2 As clsA2Pub
    Set obj1 = modA1Pub.Init1
    Set obj2 = obj1.obj2
    obj2.StrA2Pub = "1"
    Debug.Print obj2.StrA2Pub
End Sub
Sub Test52()
'    Dim obj1 As clsB1Pub
'    '別プロジェクトのPrivateなクラスは使用できない
'    Dim obj2 As clsB2Prv 'NG
'    Set obj1 = modB1Pub.Init1
'    Set obj2 = obj1.obj2
'    obj2.StrB2Prv = "2"
'    Debug.Print obj2.StrB2Prv
End Sub
Sub Test53()
'    '別プロジェクトのPrivateなクラスは使用できない
'    Dim obj1 As clsC1Prv 'NG
'    Dim obj2 As clsC2Pub
'    Set obj1 = modC1Prv.Init1
'    Set obj2 = obj1.obj2
'    obj2.StrC2Pub = "3"
'    Debug.Print obj2.StrC2Pub
End Sub
Sub Test54()
'    '別プロジェクトのPrivateなクラスは使用できない
'    Dim obj1 As clsD1Prv 'NG
'    Dim obj2 As clsD2Prv 'NG
'    Set obj1 = modD1Prv.Init1
'    Set obj2 = obj1.obj2
'    obj2.StrD2Prv = "4"
'    Debug.Print obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest6 ***
'* 親クラスのインスタンス生成時に生成した
'* 子クラスのインスタンスを変数に代入２。
'* 親クラスの変数の型はクラス名。
'* 子クラスの変数の型はObject。
Option Explicit
Sub Test61()
    Dim obj1 As clsA1Pub
    Dim obj2 As Object
    Set obj1 = modA1Pub.Init1
    Set obj2 = obj1.obj2
    obj2.StrA2Pub = "1"
    Debug.Print obj2.StrA2Pub
End Sub
Sub Test62()
    Dim obj1 As clsB1Pub
    Dim obj2 As Object
    Set obj1 = modB1Pub.Init1
    Set obj2 = obj1.obj2
    obj2.StrB2Prv = "2"
    Debug.Print obj2.StrB2Prv
End Sub
Sub Test63()
'    '別プロジェクトのPrivateなクラスは使用できない
'    Dim obj1 As clsC1Prv 'NG
'    Dim obj2 As Object
'    Set obj1 = modC1Prv.Init1
'    Set obj2 = obj1.obj2
'    obj2.StrC2Pub = "3"
'    Debug.Print obj2.StrC2Pub
End Sub
Sub Test64()
'    '別プロジェクトのPrivateなクラスは使用できない
'    Dim obj1 As clsD1Prv 'NG
'    Dim obj2 As Object
'    Set obj1 = modD1Prv.Init1
'    Set obj2 = obj1.obj2
'    obj2.StrD2Prv = "4"
'    Debug.Print obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest7 ***
'* 親クラスのインスタンス生成時に生成した
'* 子クラスのインスタンスを変数に代入３。
'* 親クラスの変数の型はObject。
'* 子クラスの変数の型はクラス名。
Option Explicit
Sub Test71()
    Dim obj1 As Object
    Dim obj2 As clsA2Pub
    Set obj1 = modA1Pub.Init1
    Set obj2 = obj1.obj2
    obj2.StrA2Pub = "1"
    Debug.Print obj2.StrA2Pub
End Sub
Sub Test72()
'    Dim obj1 As Object
'    '別ブックのPrivateなクラスは使用できない
'    Dim obj2 As clsB2Prv 'NG
'    Set obj1 = modB1Pub.Init1
'    Set obj2 = obj1.obj2
'    obj2.StrB2Prv = "2"
'    Debug.Print obj2.StrB2Prv
End Sub
Sub Test73()
    Dim obj1 As Object
    Dim obj2 As clsC2Pub
    Set obj1 = modC1Prv.Init1
    Set obj2 = obj1.obj2
    obj2.StrC2Pub = "3"
    Debug.Print obj2.StrC2Pub
End Sub
Sub Test74()
'    Dim obj1 As Object
'    '別ブックのPrivateなクラスは使用できない
'    Dim obj2 As clsD2Prv 'NG
'    Set obj1 = modD1Prv.Init1
'    Set obj2 = obj1.obj2
'    obj2.StrD2Prv = "4"
'    Debug.Print obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest8 ***
'* 親クラスのインスタンス生成時に生成した
'* 子クラスのインスタンスを変数に代入４。
'* 親クラスの変数の型はObject。
'* 子クラスの変数の型はObject。
Option Explicit
Sub Test81()
    Dim obj1 As Object
    Dim obj2 As Object
    Set obj1 = modA1Pub.Init1
    Set obj2 = obj1.obj2
    obj2.StrA2Pub = "1"
    Debug.Print obj2.StrA2Pub
End Sub
Sub Test82()
    Dim obj1 As Object
    Dim obj2 As Object
    Set obj1 = modB1Pub.Init1
    Set obj2 = obj1.obj2
    obj2.StrB2Prv = "2"
    Debug.Print obj2.StrB2Prv
End Sub
Sub Test83()
    Dim obj1 As Object
    Dim obj2 As Object
    Set obj1 = modC1Prv.Init1
    Set obj2 = obj1.obj2
    obj2.StrC2Pub = "3"
    Debug.Print obj2.StrC2Pub
End Sub
Sub Test84()
    Dim obj1 As Object
    Dim obj2 As Object
    Set obj1 = modD1Prv.Init1
    Set obj2 = obj1.obj2
    obj2.StrD2Prv = "4"
    Debug.Print obj2.StrD2Prv
End Sub

'*** 標準モジュール modTest9 ***
'* 親クラスのインスタンス生成時に
'* 子クラスのインスタンスも生成２。
'* 変数の型はObject。
Option Explicit
Sub Test91()
    Dim obj1 As Object
'   'PublicかPrivateかに関係なく
'   '別プロジェクトのクラスはNewできない。
'    Set obj1 = New clsA1Pub 'NG
'    Set obj1 = New clsA2Pub 'NG
'    Set obj1 = New clsB1Pub 'NG
'    Set obj1 = New clsB2Prv 'NG
'    Set obj1 = New clsC1Prv 'NG
'    Set obj1 = New clsC2Pub 'NG
'    Set obj1 = New clsD1Prv 'NG
'    Set obj1 = New clsD2Prv 'NG
End Sub

別プロジェクトの参照するときの注意事項
 
説明の順番が前後してしまいますが、別プロジェクトを参照するときの注意事項は以下のとおりです。
 
・複数のプロジェクトを参照する場合、VBプロジェクト名は全て異なる名前にする。
　→VBプロジェクト名が同じワークブックは参照できない。
 
・クラスなどのVBAのコードだけを格納するワークブックはThisWorkbookのIsAddinプロパティをTrueにしてアドイン形式にする。
　→別プロジェクトを参照すると参照元のワークブックの裏で参照先のワークブックのシートが表示されるのを防ぐ。
 
・A.XlsでB.xlsを参照したときに、A.xlsからB.xlsの処理は呼び出せるが、B.xlsからA.xlsの処理は呼び出せない。
　→プロジェクト内のプロシージャ数が増えてくると、A.xlsからB.xlsの処理の実行、B.xlsからA.xlsの処理の実行、といった形になる場合がある。
 
・複数のプロジェクトを参照するときに、循環参照はできない。
　→以下のような参照はできない。数が増えると循環参照に気づきにくい。
　　A.xlsでA.xlsを参照
　　A.xlsでB.xlsを参照、B.xlsでA.xlsを参照
　　A.xlsでB.xlsを参照、B.xlsでC.xlsを参照、C.xlsでA.xlsを参照
　　A.xlsでB.xlsを参照、B.xlsでC.xlsを参照、C.xlsでD.xlsを参照、D.xlsでA.xlsを参照

みなさん、こんばんは。
 
あっという間に第１弾が終了しました。
スレッド立ち上げ時の不安はすぐ吹き飛びました。私のお誘いに快く乗って頂いた方々、
ご参加頂いた方々に感謝の気持ちでいっぱいです。
私を含めROMをされていた方にとっても、とても有意義なスレッドになったのではないで
しょうか。
 
第1弾で私自身が強く感じた事は、
・クラスの構成（メンバ）を設計する際、コーディングテクニックをある程度知っておか
　なければ　メンバの決定すらも危うい。
・COM仕様も押さえておきたい！（裏側まで深く知りたければ）
・私の勉強不足！（笑）
 
少しづつ、「自分に足りない物」が見えてきております。
第2弾も今まで以上に「ワイワイガヤガヤ」でお願い致します。
 
▼どんきちさん
私自身、Friendの勉強や参照設定した際の挙動、Instancingプロパティとは？
など自分であれこれやっていましたが、
ここまで深く検証されたスレッドを私は見た事がありません。とても参考になります。
 
▼角田さん
お待ちしておりました！
当初からお誘いしたかったのですが、いままでどのサイトでも角田さんと同席した事がなく
お声を掛けられませんでした。YU-TANGさん同様、HPは隅々まで拝見させて頂いております。
私は事あるたびに「疑似からの脱却」を皆様に紹介してきたのですが、
そうしたくなるほど「衝撃」がすごかったのです。（皆様には大袈裟に聞こえるかもしれま
せんが私の人生の大きなターニングポイントになっています。）
この場を借りてお礼申し上げます。
 
引き続きご参加をよろしくお願い致します。
 
 
第1弾のお話が難しい！ついていけないよ！と感じられる方は
角田さんの「疑似からの脱却」をお薦めします。
 
http://www.h3.dion.ne.jp/~sakatsu/Breakthrough_P-Ctrl_Arrays.htm

YU-TANG さんの引用:
面倒で厳密な方は、コールバック インターフェイスを Implements して、専用メンバを隔離してしまう方法です。クラス名は ICallback○○ にすることが多いかな。自分は、ここぞというときは (仕方なく) これを使います。これで、間違って呼び出すということはほぼ不可能になりますし、ノイズにもなりません。Implements はよく多態性の側面ばかり言及されがちですが、用法としてメンバの隔離を挙げないと片手落ちな気が（自分は）しています。

Abyssさんからアドバイスを頂いていたのを見逃しておりました^^;

Abyss さんの引用:

Userformを土台どしているとしたら、UserformハンドルにTimerを掛けると
最低限の安全は保障されます。

月 さんの引用:

ObjPtr関数の戻り値をキーとするアイディア、いいですね〜。
CollectionクラスにオブジェクトをAddする時の、個人的ベストプラクティスになりそうです。
勉強になりました。

月 さんの引用:
これ、簡単なサンプル書いてもらえないですかね。

Abyss さんの引用:
IUnknown(3関数）+ IDispath（4関数）の直後にWndProcを置きますので、
IProc Interfaceの WndProc関数は、必ず最初に位置するのを前提とします。
 

Implements IProc

YU-TANG さんの引用:
これで、間違って呼び出すということはほぼ不可能になりますし、ノイズにもなりません。

Friend メソッドですが，
 
◆ Class1

Option Explicit

Private Sub PrivateMethod1()
'    Debug.Print "Private Method1"
End Sub

Public Sub PublicMethod2()
    PrivateMethod1
End Sub

Friend Sub FriendMethod3()
    PrivateMethod1              ' ここが遅いもよう
End Sub

Private Sub TestPublic()

    Const cIterate = 30000000
    Dim t As Single, i As Long, c As Class1
    
    Set c = New Class1
    t = Timer
    For i = 1 To cIterate
        c.PublicMethod2
    Next
    Debug.Print Timer - t, "public"

End Sub

Private Sub TestFriend()

    Const cIterate = 30000000
    Dim t As Single, i As Long, c As Class1
    
    Set c = New Class1    
    t = Timer
    For i = 1 To cIterate
        c.FriendMethod3
    Next
    Debug.Print Timer - t, "friend"

End Sub

引用:
気にする人は気にするかもしれません。

引用:
内部で Private メソッドを呼び出すと，
Friend メソッド呼び出し時の貯金がなくなって逆に不利になるようです。

VB6 がすぐに用意できないので試せないのですが，
今有る環境で，VBA だと，
 
Win7 32bit & Access 2010
 
 6.0625 public
 6.444336 friend
 
 6.041992 public
 6.421875 friend
 
 6.049805 public
 6.411133 friend
 
 6.043945 public
 6.413086 friend
 
 
Win7 32bit & Excel 2002
 
 5.685547 public
 5.979492 friend
 
 5.675781 public
 5.96875 friend
 
 5.671875 public
 5.96875 friend
 
 5.681641 public
 5.963867 friend
 
 
になります。
 
TestPublic/TestFriend の位置は，
標準モジュールでも，クラスモジュールでも同じ傾向になります。
　
古いPC ですが，XP SP3 & VB6 の環境もあるので後で試してみます。
　
　

YU-TANG さんの引用:
前スレで、みそじのおじさん さんが提示されていますので、そちらをご覧いただくのがよいと思います。
レス番は…って無いのか！
んーと、前スレ開けて、ブラウザ上で「48件」をテキスト検索してみていただけますか。

紹介し忘れていましたが、オススメのクラスです。
 
nanbu/CSVParser
https://github.com/nanbu/CSVParser
 
nanbu/XArray
https://github.com/nanbu/XArray

角田 さんの引用:
WithEvents を使う為、この方法は親子が１：１の場合のみ可能で、
親子が１：ｎのケースでは、従来通りに「親オブジェクト参照をクラス内に持つ」
しかない、という理解で良いでしょうか。

yayadon さんの引用:
# 但し，
# Collection や 配列で管理している要素の場合は，
# 仕組み的にイベントを受け取れないので困るんですが

こんばんは〜
 

みそじのおじさん さんの引用:
せっかくマコさんにもご参加頂いたのに申し訳なく思っております。
題材を選び直し出直してきますね。

> みそじのおじさん
役に立っていると聞くと、執筆した甲斐がありますね（嬉）
 
 
>・１つのクラスのみの構成で
>・コードも短め
>・実践的 or インパクトが強い
>・クラスの魅力を伝えられる？！
 
とりあえず、１クラス・短め・遊び易い
「ラベル点滅クラス」
http://www.h3.dion.ne.jp/~sakatsu/Excel_Tips09.htm

# 最初は前置きです。
# 途中から本題に入ります。
# 特に，月さん宛てではありません。
 
 

月 さんの引用:

yayadon さんの引用:
# 但し，
# Collection や 配列で管理している要素の場合は，
# 仕組み的にイベントを受け取れないので困るんですが

親子が１：ｎのケースではイベントは使えないかも、ということで一旦思考停止します。

Option Explicit

Public Sub Attach(clsObserver As CObserver)
    ' clsObserver は，イベント通知用
End Sub

Option Explicit

Event OnLevelChanging(clsPerson As CPerson, lngNewLevel As Long, _
                      blnCancel As Boolean)

Event OnLevelChanged(clsPerson As CPerson)

Public Sub LevelChanging(clsPerson As CPerson, lngNewLevel As Long, _
                         blnCancel As Boolean)
    RaiseEvent OnLevelChanging(clsPerson, lngNewLevel, blnCancel)
End Sub

Public Sub LevelChanged(clsPerson As CPerson)
    RaiseEvent OnLevelChanged(clsPerson)
End Sub

Private Sub Class_Terminate()
    Debug.Print "CObserver: Class_Terminate."
End Sub

Option Explicit

Implements ISubject

Private m_observer As CObserver    ' 動的配列にすれば，Observer群に対応可

Private m_userName As String
Private m_level As Long
'

Public Property Let UserName(strValue As String)
    m_userName = strValue
End Property

Public Property Get UserName() As String
    UserName = m_userName
End Property

Public Property Let Level(ByVal lngValue As Long)
    If m_level <> lngValue Then
        If m_observer Is Nothing Then  '<-- よく忘れるので注意
            m_level = lngValue
            Exit Property
        End If
        Dim blnCancel As Boolean
        Call m_observer.LevelChanging(Me, lngValue, blnCancel)
        If Not blnCancel Then
            m_level = lngValue
            Call m_observer.LevelChanged(Me)
        End If
    End If
End Property

Public Property Get Level() As Long
    Level = m_level
End Property

Private Sub Class_Terminate()
    Debug.Print "CPerson - " & m_userName & ": Class_Terminate."
End Sub

'' ISubject インターフェース
Private Sub ISubject_Attach(clsObserver As CObserver)
    Set m_observer = clsObserver
End Sub

Option Explicit

Private m_persons As Collection
'

Public Function Add(strUserName As String, _
                    Optional strDefaultLevel As Long = 3) As CPerson
    Dim clsPersons As CPersons
    Dim clsPerson As CPerson
    
    '' 重複確認 もしくは Add時にエラー処理で
    For Each clsPerson In m_persons
        If clsPerson.UserName = strUserName Then
            MsgBox "既にその名前は登録されています。"
            Exit Function
        End If
    Next

    Set clsPerson = New CPerson
    clsPerson.UserName = strUserName
    clsPerson.Level = strDefaultLevel
    Call m_persons.Add(clsPerson, strUserName)
    Set Add = clsPerson
End Function

Public Property Get Item(strUserName As String) As CPerson
    Set Item = m_persons.Item(strUserName)
End Property

Private Sub Class_Initialize()
    Set m_persons = New Collection
End Sub

Private Sub Class_Terminate()
    Debug.Print "CPersons: Class_Terminate."
End Sub

Option Explicit

Private m_clsPersons As CPersons
Private WithEvents m_clsObserver As CObserver
'

Private Sub Class_Initialize()
    Dim clsObserver As CObserver
    Dim itfSubject As ISubject
    Dim clsPersons As CPersons
    Dim vntElement As Variant
    
    Set clsObserver = New CObserver
    Set clsPersons = New CPersons
    For Each vntElement In Array("yayadonさん", _
                                 "ろひさん", _
                                 "simpleさん", _
                                 "月さん", _
                                 "ゴマさん", _
                                 "kumattiさん", _
                                 "YU-TANGさん", _
                                 "Kanabunさん", _
                                 "Abyssさん", _
                                 "みそじのおじさん")
        Set itfSubject = clsPersons.Add(CStr(vntElement))
        Call itfSubject.Attach(clsObserver)
    Next
    Set m_clsPersons = clsPersons
    Set m_clsObserver = clsObserver
End Sub

Private Sub Class_Terminate()
    Debug.Print "CTestContainer: Class_Terminate."
End Sub

'' Test CPersons.Add
Public Sub TestAdd(strUserName As String, Optional strLevel As Long = 3)
    Call m_clsPersons.Add(strUserName)
End Sub

'' Test CPersons.Item
Public Function TestItem(strUserName As String) As CPerson
    Set TestItem = m_clsPersons.Item(strUserName)
End Function

'' OnLevelChanging ハンドラ メソッドの一例
Private Sub m_clsObserver_OnLevelChanging(clsPerson As CPerson, _
                                          lngNewLevel As Long, _
                                          blnCancel As Boolean)
    Dim result As VbMsgBoxResult
    Dim strMsg As String
    strMsg = clsPerson.UserName & "のレベルが" & vbCrLf & _
             clsPerson.Level & " から" & lngNewLevel & " に" & vbCrLf & _
             "変更されようとしています。" & vbCrLf & _
             "許可しますか？"
    result = MsgBox(strMsg, vbYesNo Or vbDefaultButton2 Or vbInformation, _
                    "変更の確認: ユーザーのレベル")
    If result = vbNo Then
        blnCancel = True
    End If
End Sub

'' OnLevelChanged ハンドラ メソッドの一例
Private Sub m_clsObserver_OnLevelChanged(clsPerson As CPerson)
    MsgBox clsPerson.UserName & "のレベルが " & _
           clsPerson.Level & " に変化しました。"
End Sub

Private Sub Test1()

    Dim clsTestContainer As CTestContainer
    Dim clsPerson As CPerson
    
    Debug.Print "Test 開始"
    
    Set clsTestContainer = New CTestContainer
    
    MsgBox "Test CPersons.Add"
    Call clsTestContainer.TestAdd("月さん")
    
    MsgBox "Test CPersons.Item"
    Set clsPerson = clsTestContainer.TestItem("月さん")
    
    '' イベントのテストも兼ねてます。
    MsgBox "Test CPerson.Level"
    clsPerson.Level = clsPerson.Level + 1
    
    Set clsPerson = Nothing
    Set clsTestContainer = Nothing   ' Class_Terminate がすべて呼ばれるハズ
    
    MsgBox "終了"
    
    Debug.Print "Test 終了"
    
End Sub

Test 開始
CTestContainer: Class_Terminate.
CPersons: Class_Terminate.
CPerson - yayadonさん: Class_Terminate.
CPerson - ろひさん: Class_Terminate.
CPerson - simpleさん: Class_Terminate.
CPerson - 月さん: Class_Terminate.
CPerson - ゴマさん: Class_Terminate.
CPerson - kumattiさん: Class_Terminate.
CPerson - YU-TANGさん: Class_Terminate.
CPerson - Kanabunさん: Class_Terminate.
CPerson - Abyssさん: Class_Terminate.
CPerson - みそじのおじさん: Class_Terminate.
CObserver: Class_Terminate.
Test 終了

CTestContainer さんの引用:
---------------------------
変更の確認: ユーザーのレベル
---------------------------
月さんのレベルが
3 から4 に
変更されようとしています。
許可しますか？
---------------------------
はい(Y) いいえ(N)
---------------------------

上のコードの CPersons クラス の Add メソッドで，
Dim clsPersons As CPersons
という変数が入っていますが，余分なので削除してください。
 
# 普段，モジュール レベルの変数を
# 一度，ローカル変数に受けてから操作する癖になっていて，
# ノイズになるのでやめたのですが，
# 変数だけ残ってました。
　
　

> デジタル時計
 
既に出来上がっているのなら、(多分、ご存知でしょうけど)VBSで定番のタイマーに置換ればいいのではと。
それで(VBSの)GetRefは、既定メソッドを持ったオブジェクトを返すので
結果的にクラスモジュールが2つ必要ですが、
分かり易さを優先するなら、こちらかなと。
 
IHTMLWindow2::setInterval Method
http://msdn.microsoft.com/en-us/library/aa741499%28v=vs.85%29.aspx
 
# ShellオブジェクトのShellExecuteでtimedate.cplを
  出すのもデジタル時計かなと。

角田さん、朗報です。
 

角田 さんの引用:
WithEvents を使う為、この方法は親子が１：１の場合のみ可能で、
親子が１：ｎのケースでは、従来通りに「親オブジェクト参照をクラス内に持つ」
しかない、という理解で良いでしょうか。

親子が１：ｎのケースで、親への参照を保持せずに親への参照を得ることだけを目的とした、シンプルなオブジェクトモデルを書きました。yayadonさんが書かれたObserverパターンのサブセットになります。
 
yayadonさん、今回も知恵を与えてくださってありがとうございます。
YU-TANGさん、インターフェイスを使ってメンバを隠す方法も理解できました。
YU-TANGさんとみそじのおじさん、ありがとうございました。
 
はぐれメタルを5匹くらい倒した気分です。

みなさん、こんにちは。
今日は朝から、長女の小学校の卒業式がありバタバタしておりました。^^
 
▼マコさん
　皆様がよく使う「Rangeオブジェクト」の機能を拡張してみよう！と勢いよくやって
　おりましたが（RangeEx("A1:C2").Averageなどと書けます）、やっていく内に
  深みにはまりました、、興味を持って頂けるかなと選んだ題材でしたが、やれば
  やるほど複雑な構成になってしまいました（現在の所クラスを３個使用）
　Range().と打ってメンバの一覧が出てきますが「こんなメソッドやプロパティ
　があったら便利かなと思うものを自作する」に挑戦しております^^　
 
▼月さん
　1:1の関係でWithEventsで親を得るのは理解出来ました。上のRangeExクラスはそれを使って
　おります。次は1:nのWithEventsに取り組みたいと思います。
 
# 「はぐれメタル」笑いました。もしかして同世代ですか？私はど真ん中です^^
 
▼角田さん
ご紹介ありがとうございます。
みなさん角田さんのHPは要「Check It Out!」ですよ^^
 
▼yayadonさん
これからじっくり取り組んででみます^^
 
▼kumattiさん
VBSの件は存じ上げておりませんでした。これから見てみますね。
ありがとうございます。
 
 
 
# 長女も小学校卒業、下の子も卒園でした。
　プログラミングは計画的に行っておりますが、年の差を６歳で、、
　家族計画はまったく無計画でした^^　入学も２つダブりです。
　諭吉に羽が生えたように飛んで行きます^^;

こんにちは。
 
> 月さん
> 親子が１：ｎのケースでも、イベントを使って実現可能でした。
> 親オブジェクトへの参照を保持せずに親オブジェクトへの参照を得る方法2
 
隠蔽用の ILink を噛ませているので、
ちょっと読解し難くなっていますが、簡単に言えば、
 

UserForm で子１〜３のイベントを受け取る為に、
UserFormと子の間に親クラスを設ける

UserForm
　↑
　│(1:1) RaiseEventによるイベント授受
　親
　↑
　│(1:n) 直Call
┌┴─┬──┐
子１・子２・子３
　

親 でも子１〜３のイベントを受け取る為に、
更に、親と子の間に叔父クラスを設ける

UserForm
　↑
　│(1:1) RaiseEventによるイベント授受
　親
　↑↑　　　　(1:1) RaiseEventによるイベント授受
　│┗━━━━━━━━━┓
　│　　　　　　　 　　叔父
　│(1:n) 直Call　　　　↑
┌┴─┬──┐　　　　　┃
子１・子２・子３　　　　┃
　┃　　┃　　┃　　　　┃
　┗━━┻━━┻━━━━┛
　　　　　(1:n) 直Call
　

みそじのおじさん さんの引用:
# 「はぐれメタル」笑いました。もしかして同世代ですか？私はど真ん中です^^

角田 さんの引用:
隠蔽用の ILink を噛ませているので、
ちょっと読解し難くなっていますが

角田 さんの引用:
「親オブジェクトを持たせない為に、ここまでする」という 利点 が
いまひとつ見えて来ません。

月さんからご紹介があった
>nanbu/CSVParser
>https://github.com/nanbu/CSVParser
>nanbu/XArray
>https://github.com/nanbu/XArray
は、大変参考になります。ありがとうございます。
 
後者に関してですが、
> 7.任意の順でソートするにはCompareメソッドを備えたカスタムクラスを作り、
> インスタンスをSortメソッドの引数に指定します。
これについては、月さんの
https://gist.github.com/1196564
の紹介がないと、完結しませんよね。
遠慮なさっているようなので、代わって。
 
# Rubyのブロックに慣れてしまっている私からすると、カスタムクラスを作らないといけないのは、
# ちょっと迂遠な感じはあるわけですが、VBAではこうするのが最善なんですねえ。
# （単なる個人的感想です。別の言語の話を持ち出すのは、反則ですけど）

simple さんの引用:
月さんからご紹介があった
>nanbu/CSVParser
>https://github.com/nanbu/CSVParser
>nanbu/XArray
>https://github.com/nanbu/XArray
は、大変参考になります。ありがとうございます。

simple さんの引用:
後者に関してですが、
> 7.任意の順でソートするにはCompareメソッドを備えたカスタムクラスを作り、
> インスタンスをSortメソッドの引数に指定します。
これについては、月さんの
https://gist.github.com/1196564
の紹介がないと、完結しませんよね。

使い方 さんの引用:
7. 任意の順でソートするにはCompareメソッドを備えたカスタムクラスを作り、インスタンスをSortメソッドの引数に指定します。

simple さんの引用:
# Rubyのブロックに慣れてしまっている私からすると、カスタムクラスを作らないといけないのは、
# ちょっと迂遠な感じはあるわけですが、VBAではこうするのが最善なんですねえ。

角田さんが書かれた、「簡単に言えば、」以降のご説明ですが、大変申し訳ないのですが、理解できませんでした。私の理解力が足りないのかもしれません。
 
yayadonさんのご説明と私のコードを見て、ごっちゃになっちゃったのかなぁ、という気がしています。
 
私が言葉足らずだったのですが、私のコードは、yayadonさんのご説明とコードから、特定の部分だけをある目的のために抜き出して追加修正したものです。よって、考え方で共通している部分はあるのですが、まったく別物と見るのが最初はいいかもしれません。
 
失礼な言い方になってしまうのですが、私のコードをご理解されてからyayadonさんのご説明を読むとわかりやすいかもしれません。
 
ほんとすみません。

みそじのおじさん さんの引用:
知人　「falseはフォルス！」

休日前の夜ですので、ちょっと息抜きです。
 

月 さんの引用:

私や私の周りはフォールスと呼んでいます。

みそじのおじさん さんの引用:
「False 読み方」で、ちょっと検索してみましたがどちらの読み方が多いのでしょうかね？
気になります^^

引用:
私や私の周りはフォールスと呼んでいます。

そうはなっていても、ルールを守らずにいきなり終了する人は居る。
・そうされた時に、どういう状態になるのか？
　　⇒ ref-count がゼロにならない
　　　⇒ オブジェクトが解放されずに宙ぶらりんで残ってしまう
　　　　⇒ トラブルの素になる危険あり
・そうされたとしても安全な造りにするには、どうするか？
　　⇒ Clearメソッドなどを用意しなくても良い仕組みは？
　　　⇒ そもそも循環参照にならない仕組みにしておけばＯＫ

�@「弱参照」形態
　オブジェクト参照（ポインタ）を 数値(Long型)で保持する事で、システム(VBA)側に
　「参照が無い」ように見せ掛ける。オブジェクトを使う場面になったら、その時々で、
　数値を一時的に（ローカル変数で）ポインタに再変換してオブジェクトを操作する。
　ただし、そうすると、未だ使うのに、システムが「もう誰も使っていない」と解放して
　しまったら困るので、自分よりも寿命の長い上位オブジェクト（自分の呼び出し元）に
　限るべき。

�A WithEvents & Event/RaiseEvent セットによるカスタムイベントの仕組みの中では、
　イベントの通知元オブジェクト（子）vs受領オブジェクト（親）間で、オブジェクト
　参照が循環しないようになっている。
　[子]で[親]参照を保持し、[子]の中で[親]メンバを操作するような処理は、
　　・その処理のタイミングをカスタムイベントとして[親]に上げ、
　　・『親メンバの操作』処理そのものを[親]の中へ移す
　ようにすれば何ら気兼ねする事無く安全。
　ただし、WithEvents を使うので[親：子]の関係は１対１に限られる。
　１対１の関係であれば、検討する価値は大いにある。

�B カスタムイベントを巧く利用すると、イベントプロシジャーを通して、[親]参照を
　受け取る仕組みを造れる。必要な時に必要な間だけローカル変数で[親]参照を持てる
　ので、モジュール変数で[親]参照を保持し続ける必要が無くなり、循環参照の危険を
　無くしつつ、[子]の中で[親]メンバを操作できるようになる。
　（このスレッドでは、親子は１対１まで）

・わたしの「擬似からの脱却」でいう [Raiseほにゃらら]メソッド（[子]から呼ぶ、[親]の
　中のイベント通知メソッド）等が Public なので、インテリセンスの候補リストに載り、
　利用者に見えている。
　⇒ 間違って使われるとトラブルになる。
　　⇒ 隠す方法は無いか？
　　　⇒ ・Public を Friend に変える（Import 形態では効果は無いが、アドイン形態
　　　　　　（別プロジェクト）では見えなくなり有効）
　　　　 ・インターフェース部分を Implements 形態にすることで、インテリセンスの
　　　　　　候補リストに載らないようにできる（Import でも有効）。

・どんきち さん提示のものは、
　　「複数のクラス（Ａ,Ｂ,Ｃ…）が持っている共通イベントを纏める」
　　「クラス（オブジェクト、コントロール）配列のイベントを纏める」
　という利用例の違いはありますが、わたしが書いている『擬似からの脱却』と同等の
　考え方（利用側と対象クラスの間に、イベントを纏めるクラスを挟む）ですね。
　
　最近は、大分「クラスを２重に使う」という、この手の方法が浸透しましたが、
　昔はどうだったんでしょうね（ＶＢＡ界では）？　記事でも書いてますが
　　　　[§９  擬似の足枷]
　　　　この機能は「Excel2000(1999/6 リリース) からサポート」されています。
　　　　まさか、５年もの間、誰も気付かなかった？ そんな馬鹿な (oT▽T)ノ彡

　『いや、実は昔っから知ってたし、使ってた』という識者が居なかったとは
　思えないんだけど……　
　解説するのが面倒だから言わなかったって人、居るんだろうなぁ〜
　（実際、とっても面倒だったし）

VBAにおいては、MVC(Model-View-Controller)モデルの文脈が、暗黙に扱われることは多いという印象を持っていたのですが、yayadonさんからObserverパターンの具体的なコード例が提示されてしまい、このトピック自体に圧倒されています。
 

角田 さんの引用:
（１）は、ここまで（理解しながら読むには長いし疲れますね・・・）

ひ〜
 

月 さんの引用:
親オブジェクトへの参照を保持せずに親オブジェクトへの参照を得る方法2
https://gist.github.com/2054643
ILinkインターフェイス不使用版
https://gist.github.com/643df93dc39c44644afa

ここも話がややこしいので、よっぽど興味のある方以外はスルーしてくださってOKです。
 

月 さんの引用:
MaxItemCountOverイベントを定義するのはclsContainersじゃなくてclsContainerじゃないですかね。

月 さんの引用:
親オブジェクトへの参照を保持せずに親オブジェクトへの参照を得る方法
https://gist.github.com/2041685

月 さんの引用:
親オブジェクトへの参照を保持せずに親オブジェクトへの参照を得る方法2
https://gist.github.com/2054643

角田 さんの引用:
という流れですよね。
 
それで、その方法論として

> 不利なケース　12/03/16 03:52:11　yayadon
 
これ、まだ結論が出てませんね。

Abyss さんの引用:
> 不利なケース　12/03/16 03:52:11　yayadon
これ、まだ結論が出てませんね。

「７セグメント」デジタル時計　を「タイマーコントロール」クラスの
サンプルとして作ってみました。
http://www.h3.dion.ne.jp/~sakatsu/Excel_Tips15.htm
 
「７セグメント」数字を扱う為の clsDec7Seg クラスも公開しました。
クラスとしては、単機能で短め、効果が判り易いので、例題としても良いかもしれません。

こんばんは。
有益な議論が進んでいて何よりです。
月さんからコメントいただいたままになっていました。小用あって遅くなりました。
あらためて、ValueComparerの趣旨を説明いただきありがとうございました。
 
"完結"という言葉が不適切で、誤解を呼んだようです。
併せて紹介されるとよろしいのでは、と書いたほうがよかったですね。
少し言い訳すると、Compareメソッドを備えたクラスのインスタンスを引数に入れればOK、
ということはむろん承知しています。
インターフェイスを使わないとダメと申し上げた訳ではありません。
折角Githubに公開されていたのを見かけましたので、
インターフェイスを用いたポリモーフィズムの良い例の紹介にもなると思ったのです。
（紹介行為の完結ですね、敢えて言うと。
  まあ、C言語のqsort関数と考えは同じだから、プロの方がたにとっては、
  常識以前の話で今更ということだったかも知れないですが、
  幅広いかたがたの参考になると思いました。）
どうも失礼しました。

みそじのおじさん
二人のお子様のご卒業とご卒園、おめでとうございます♪
卒業と入学がダブルで、この春はお祝い続きですね。
 

みそじのおじさん さんの引用:
▼マコさん
　皆様がよく使う「Rangeオブジェクト」の機能を拡張してみよう！と勢いよくやって
　おりましたが（RangeEx("A1:C2").Averageなどと書けます）、やっていく内に
  深みにはまりました、、興味を持って頂けるかなと選んだ題材でしたが、やれば
  やるほど複雑な構成になってしまいました（現在の所クラスを３個使用）
　Range().と打ってメンバの一覧が出てきますが「こんなメソッドやプロパティ
　があったら便利かなと思うものを自作する」に挑戦しております^^　

角田 さんの引用:
とりあえず、１クラス・短め・遊び易い
「ラベル点滅クラス」
http://www.h3.dion.ne.jp/~sakatsu/Excel_Tips09.htm

# Friend の件 遅くなりました。
 
 
まず，Win XP SP3 での結果

WinXP SP3 & Excel 2002 SP3 .xls　　' 10% 程の差が出る

 17.35913     public
 15.92188     friend

 17.40698     public
 15.78101     friend

 17.375       public
 15.76611     friend

 17.32788     public
 15.78101     friend


WinXP SP3 & VB6 SP6 (Ctrl+F5) デバッグ　　' 15% 程の差が出る

 19.0459      public
 16.3291      friend

 19.07813     public
 16.18701     friend

 19.10986     public
 16.20313     friend

 18.73389     public
 16.17188     friend


WinXP SP3 & VB6 SP6 P-Code compiled EXE　　' 差がハッキリ出ない

16.32799 --- public
16.1411 --- friend

16.32799 --- public
16.12486 --- friend

16.31211 --- public
16.1571 --- friend

16.34386 --- public
16.23411 --- friend


WinXP SP3 & VB6 SP6 Native compiled EXE　　' かなり明確に差が出る

3.500226 --- public
0.5002266 --- friend

3.485227 --- public
0.5002266 --- friend

3.500226 --- public
0.5002266 --- friend

3.483875 --- public
0.4999883 --- friend

 5.643066     public
 5.533203     friend

 5.64502      public
 5.545898     friend

 5.645996     public
 5.53418      friend

 5.652832     public
 5.525391     friend

 5.641602     public
 6.016602     friend

 5.647461     public
 6.003906     friend

 5.646484     public
 6.018555     friend

 5.649414     public
 6.005859     friend

Win7 SP1 & VB6 SP6 P-Code compiled On WinXP SP3

5.41423 --- public
5.218867 --- friend

5.406902 --- public
5.219188 --- friend

5.439223 --- public
5.214793 --- friend

5.41907 --- public
5.212149 --- friend


Win7 SP1 & VB6 SP6 Native compiled On WinXP SP3　　' かなり明確に差が出る

1.132828 --- public
0.1911563 --- friend

1.144242 --- public
0.1902227 --- friend

1.14882 --- public
0.188918 --- friend

1.150176 --- public
0.1898086 --- friend

みなさん、おはようございます。
 
▼角田さん
「まとめ」ありがとうございます^^
私のコードは角田さんの影響が色濃く出ていると思います。
Timerクラスも以前使わせて頂きましたが、「ダメダメ、コピペするのではなく、これが
自分の頭の中から出てこないと！」と発奮してやっていたのを思いだします。
clsDec7Segも拝見させて頂きました。番号の振り方に違いがあるものの自分の考えが
大きくはずしていなかったので安心しました。
 
▼ろひさん
「まとめ」ありがとうございます。
もうこれは何か一冊の本の目次みたいですね^^とても見易いです。
私は（１）を何度も読み直しておりますが、大変なボリュームで理解するのに必死です。
 
下記の言葉が大変印象に残りました。
>●VBAクラスの制限事項 - 欠点転ずれば可能性に繋がる
「欠点転ずれば可能性に繋がる」
私が「VBA クラス」と検索をしてよく「VBAでクラスを使ってみた」的な題名で
ブログを書かれている方のページに飛ぶ事が多いのですが、見てみますと
VBAの欠点ばかりの指摘でコードすらも載っていないなんて事がよくありました^^;
他言語から見ると、大変制限の多いVBAのクラスモジュールですが、そんな中でも
可能性を見出す！とても共感いたします。
（皆様のように「インラインアセンブリ」を使われている方は、私の中では
ある意味「制限」を遥かに越えていますが！（笑））
 
▼月さん
やってみました。「なるほど！」と唸りました。
クラスがどのようなメンバを持つべきか非常に勉強になりました！！
 
私がクラスを作成する手順は大体
・題材の決定
・紙面上で簡単なフローチャートの作成（かなり大雑把です・・）
・実際のコーディング
 
このフローチャートが貧弱すぎるのにコーディングを始めてしまうので、後付けや後戻り
が出来なくなるパターンが多いです^^;もっとフローチャートの時点で綿密な設計が
必要だとこのスレッドから痛感致しております。
 
▼yayadonさん
 

yayadon さんの引用:

いわゆるデザイン パターンと呼ばれているお決まりのパターンの中で，
Observer パターン(Observer Pattern)と呼ばれています。

yayadon さんの引用:

まず，これを理解しておくと，
Subject クラスを別に用意するパターンを理解しやすくなります。たぶん。

# 角田さんからサンプルが出されたので不要ですが。
 
> VBSで定番のタイマー
 
ShellのBrowseForFolderでString型変数を
渡してコケるのと同じ理屈で、クラスのインスタンスをキャスト(CVar)するか、
参照設定用のコードに直す必要があります。
(COM側の作り込みが甘いそうです)

# こんなパターンな "感じ" というものなので，
# このように，実装しないといけないというものではありません。
# 土台となるフレームワークや使用する言語の特性によって変わってきます。
# VBA であえてモデルどおりにやるならばという話です。
 
 

みそじのおじさん さんの引用:

yayadon さんの引用:

まず，これを理解しておくと，
Subject クラスを別に用意するパターンを理解しやすくなります。たぶん。

これも時期を見てお願いできないでしょうか？完全に理解出来ていないからだと思い
ますが、自分の中から出てきません^^;

Option Explicit

Event OnLevelChanging(clsPerson As CPerson, _
                      lngNewLevel As Long, blnCancel As Boolean)

Event OnLevelChanged(clsPerson As CPerson)


'' 以下，Update(CPerson) メソッド

Public Sub LevelChanging(clsPerson As CPerson, _
                         lngNewLevel As Long, blnCancel As Boolean)
    RaiseEvent OnLevelChanging(clsPerson, lngNewLevel, blnCancel)
End Sub

Public Sub LevelChanged(clsPerson As CPerson)
    RaiseEvent OnLevelChanged(clsPerson)
End Sub


''-----
Private Sub Class_Terminate()
    Debug.Print "CPersonObserver: Class_Terminate."
End Sub

Option Explicit

Public Sub Attach(clsObserver As CPersonObserver)
    ' clsObserver は，イベント通知用
End Sub

'' 無くても可。
Public Sub Detach(clsObserver As CPersonObserver)
    ' clsObserver は，イベント通知用
End Sub


'' 以下 Notify(CPerson)

''Public Sub LevelChanging(clsPerson As CPerson, _
''                         lngNewLevel As Long, blnCancel As Boolean)
''End Sub
''
''Public Sub LevelChanged(clsPerson As CPerson)
''End Sub

Option Explicit

Implements IPersonSubject

'' Detach が必要ない場合は，動的配列でも構いません。
Private m_observers As Collection
'

Private Sub Class_Initialize()
    Set m_observers = New Collection
End Sub

Private Sub Class_Terminate()
    Debug.Print "IPersonSubjectImpl: Class_Terminate."
End Sub

Private Sub IPersonSubject_Attach(clsObserver As CPersonObserver)
    Dim observer As CPersonObserver
    '' 重複確認  --- 単にエラー処理でも可。
    For Each observer In m_observers
        If observer Is clsObserver Then
            Debug.Print "オブザーバーは登録済み。"
            Exit Sub
        End If
    Next
    Call m_observers.Add(clsObserver)
End Sub

Private Sub IPersonSubject_Detach(clsObserver As CPersonObserver)
    Dim observer As CPersonObserver
    '' 登録済みのもののみ削除  --- 単にエラー処理でも可。
    For Each observer In m_observers
        If observer Is clsObserver Then
            Call m_observers.Remove(clsObserver)
            Exit Sub
        End If
    Next
    Debug.Print "未登録のオブザーバーに対して削除。"
End Sub


'' 以下 Notify(CPerson)

Public Sub LevelChanging(clsPerson As CPerson, _
                         lngNewLevel As Long, blnCancel As Boolean)
    Dim observer As CPersonObserver
    For Each observer In m_observers
        Call observer.LevelChanging(clsPerson, lngNewLevel, blnCancel)
    Next
End Sub

Public Sub LevelChanged(clsPerson As CPerson)
    Dim observer As CPersonObserver
    For Each observer In m_observers
        Call observer.LevelChanged(clsPerson)
    Next
End Sub

Option Explicit

Implements IPersonSubject

Private m_personSubject As IPersonSubjectImpl


Private m_userName As String
Private m_level As Long
'

Public Property Let UserName(strValue As String)
    m_userName = strValue
End Property

Public Property Get UserName() As String
    UserName = m_userName
End Property

Public Property Let Level(ByVal lngValue As Long)
    If m_level <> lngValue Then
        If m_personSubject Is Nothing Then
            m_level = lngValue
            Exit Property
        End If
        Dim blnCancel As Boolean
        Call m_personSubject.LevelChanging(Me, lngValue, blnCancel)
        If Not blnCancel Then
            m_level = lngValue
            Call m_personSubject.LevelChanged(Me)
        End If
    End If
End Property

Public Property Get Level() As Long
    Level = m_level
End Property

Private Sub Class_Initialize()
    Set m_personSubject = New IPersonSubjectImpl
End Sub

Private Sub Class_Terminate()
    Debug.Print "CPerson - " & m_userName & ": Class_Terminate."
End Sub
 
 
'' 以下，IPersonSubject インターフェース

Private Sub IPersonSubject_Attach(clsObserver As CPersonObserver)
    Dim personSubject As IPersonSubject
    Set personSubject = m_personSubject
    Call personSubject.Attach(clsObserver)
End Sub

Private Sub IPersonSubject_Detach(clsObserver As CPersonObserver)
    Dim personSubject As IPersonSubject
    Set personSubject = m_personSubject
    Call personSubject.Detach(clsObserver)
End Sub

Option Explicit

Private m_persons As Collection
'

Public Function Add(strUserName As String, _
                    Optional strDefaultLevel As Long = 3) As CPerson
    Dim clsPersons As CPersons
    Dim clsPerson As CPerson
    
    '' 重複確認 もしくは Add時にエラー処理で
    For Each clsPerson In m_persons
        If clsPerson.UserName = strUserName Then
            MsgBox "既にその名前は登録されています。"
            Exit Function
        End If
    Next

    Set clsPerson = New CPerson
    clsPerson.UserName = strUserName
    clsPerson.Level = strDefaultLevel
    Call m_persons.Add(clsPerson, strUserName)
    Set Add = clsPerson
End Function

Public Property Get Item(strUserName As String) As CPerson
    Set Item = m_persons.Item(strUserName)
End Property

Private Sub Class_Initialize()
    Set m_persons = New Collection
End Sub

Private Sub Class_Terminate()
    Debug.Print "CPersons: Class_Terminate."
End Sub

Option Explicit

Private m_clsPersons As CPersons
Private WithEvents m_clsObserver As CPersonObserver
'

Private Sub Class_Initialize()
    Dim clsObserver As CPersonObserver
    Dim itfSubject As IPersonSubject
    Dim clsPersons As CPersons
    Dim vntElement As Variant
    
    Set clsObserver = New CPersonObserver
    Set clsPersons = New CPersons
    For Each vntElement In Array("yayadonさん", _
                                 "ろひさん", _
                                 "simpleさん", _
                                 "月さん", _
                                 "ゴマさん", _
                                 "kumattiさん", _
                                 "YU-TANGさん", _
                                 "Kanabunさん", _
                                 "Abyssさん", _
                                 "みそじのおじさん")
        Set itfSubject = clsPersons.Add(CStr(vntElement))
        Call itfSubject.Attach(clsObserver)
    Next
    Set m_clsPersons = clsPersons
    Set m_clsObserver = clsObserver
End Sub

Private Sub Class_Terminate()
    Debug.Print "CTestContainer: Class_Terminate."
End Sub

'' Test CPersons.Add
Public Sub TestAdd(strUserName As String, Optional strLevel As Long = 3)
    Call m_clsPersons.Add(strUserName)
End Sub

'' Test CPersons.Item
Public Function TestItem(strUserName As String) As CPerson
    Set TestItem = m_clsPersons.Item(strUserName)
End Function

Private Sub m_clsObserver_OnLevelChanging(clsPerson As CPerson, _
                                          lngNewLevel As Long, _
                                          blnCancel As Boolean)
    Dim result As VbMsgBoxResult
    Dim strMsg As String
    strMsg = clsPerson.UserName & "のレベルが" & vbCrLf & _
             clsPerson.Level & " から" & lngNewLevel & " に" & vbCrLf & _
             "変更されようとしています。" & vbCrLf & _
             "許可しますか？"
    result = MsgBox(strMsg, vbYesNo Or vbDefaultButton2 Or vbInformation, _
                    "変更の確認: ユーザーのレベル")
    If result = vbNo Then
        blnCancel = True
    End If
End Sub

Private Sub m_clsObserver_OnLevelChanged(clsPerson As CPerson)
    MsgBox clsPerson.UserName & "のレベルが " & _
           clsPerson.Level & " に変化しました。"
End Sub

Private Sub Test1()

    Dim clsTestContainer As CTestContainer
    Dim clsPerson As CPerson
    
    Debug.Print "Test 開始"
    
    Set clsTestContainer = New CTestContainer
    
    MsgBox "Test CPersons.Add"
    Call clsTestContainer.TestAdd("みそじのおじさん")
    
    MsgBox "Test CPersons.Item"
    Set clsPerson = clsTestContainer.TestItem("みそじのおじさん")
    
    '' イベントのテストも兼ねてます。    
    MsgBox "Test CPerson.Level"
    clsPerson.Level = clsPerson.Level + 1
    
    '' CPerson クラスのテスト
    MsgBox clsPerson.UserName & " の現在のレベルは " & _
           clsPerson.Level & " です。"
    
    Set clsPerson = Nothing
    Set clsTestContainer = Nothing   ' Class_Terminate がすべて呼ばれるハズ
    
    MsgBox "終了"
    
    Debug.Print "Test 終了"
    
End Sub

Test 開始
CTestContainer: Class_Terminate.
CPersons: Class_Terminate.
CPerson - yayadonさん: Class_Terminate.
IPersonSubjectImpl: Class_Terminate.
CPerson - ろひさん: Class_Terminate.
IPersonSubjectImpl: Class_Terminate.
CPerson - simpleさん: Class_Terminate.
IPersonSubjectImpl: Class_Terminate.
CPerson - 月さん: Class_Terminate.
IPersonSubjectImpl: Class_Terminate.
CPerson - ゴマさん: Class_Terminate.
IPersonSubjectImpl: Class_Terminate.
CPerson - kumattiさん: Class_Terminate.
IPersonSubjectImpl: Class_Terminate.
CPerson - YU-TANGさん: Class_Terminate.
IPersonSubjectImpl: Class_Terminate.
CPerson - Kanabunさん: Class_Terminate.
IPersonSubjectImpl: Class_Terminate.
CPerson - Abyssさん: Class_Terminate.
IPersonSubjectImpl: Class_Terminate.
CPerson - みそじのおじさん: Class_Terminate.
IPersonSubjectImpl: Class_Terminate.
CPersonObserver: Class_Terminate.
Test 終了

みそじのおじさん、面食らってください ふふふ(-∀-)

yayadon さんの引用:
Notify(CPerson) 群は，インターフェースに入れず，コメント アウトします。
VBA では，インターフェースの継承もできない関係もあって，
こうすることにしました。

Option Explicit

Public Sub Attach(vntObserver As Variant)
    ' vntObserver は，イベント通知用
End Sub

Public Sub Detach(vntObserver As Variant)
    ' vntObserver は，イベント通知用
End Sub

Option Explicit

''Implements ISubject
''
''Private Sub ISubject_Attach(vntObserver As Variant)
''
''End Sub
''
''Private Sub ISubject_Detach(vntObserver As Variant)
''
''End Sub

'' 以下 Notify(CPerson)

Public Sub LevelChanging(clsPerson As CPerson, _
                         lngNewLevel As Long, blnCancel As Boolean)
End Sub

Public Sub LevelChanged(clsPerson As CPerson)
End Sub

Option Explicit

Implements ISubject
Implements IPersonSubject

Private m_observers As Collection
'

Private Sub Class_Initialize()
    Set m_observers = New Collection
End Sub

Private Sub Class_Terminate()
    Debug.Print "IPersonSubjectImpl: Class_Terminate."
End Sub

Private Sub ISubject_Attach(vntObserver As Variant)
    '同様
End Sub

Private Sub ISubject_Detach(vntObserver As Variant)
    '同様
End Sub

Private Sub IPersonSubject_LevelChanging(clsPerson As CPerson, _
                                         lngNewLevel As Long, blnCancel As Boolean)
    '同様
End Sub

Private Sub IPersonSubject_LevelChanged(clsPerson As CPerson)
    '同様
End Sub

# VBA のクラスで，こんなにややこしいことをしたのは初めてなので，
# いいえ を押されなければ，私もレベル アップしたハズ。(笑)
 
 
コードだけもう一度張り付けておきます。
おかしなところは，修正してください。
あくまで，VBA でやってみると... という話なので，よろしく。
 
 
'' CPersonObserver　　--- インターフェース/具象クラス兼務

Option Explicit

Event OnLevelChanging(clsPerson As CPerson, _
                      lngNewLevel As Long, blnCancel As Boolean)

Event OnLevelChanged(clsPerson As CPerson)

Public Sub LevelChanging(clsPerson As CPerson, _
                         lngNewLevel As Long, blnCancel As Boolean)
    RaiseEvent OnLevelChanging(clsPerson, lngNewLevel, blnCancel)
End Sub

Public Sub LevelChanged(clsPerson As CPerson)
    RaiseEvent OnLevelChanged(clsPerson)
End Sub

Private Sub Class_Terminate()
    Debug.Print "CPersonObserver: Class_Terminate."
End Sub

Option Explicit

Public Sub Attach(vntObserver As Variant)
    ' vntObserver は，イベント通知用
End Sub

'' 無くても可。
Public Sub Detach(vntObserver As Variant)
    ' vntObserver は，イベント通知用
End Sub

Option Explicit

''Implements ISubject
''
''Private Sub ISubject_Attach(vntObserver As Variant)
''
''End Sub
''
''Private Sub ISubject_Detach(vntObserver As Variant)
''
''End Sub

'' 以下 Notify(CPerson)

Public Sub LevelChanging(clsPerson As CPerson, _
                         lngNewLevel As Long, blnCancel As Boolean)
End Sub

Public Sub LevelChanged(clsPerson As CPerson)
End Sub

Option Explicit

Implements ISubject
Implements IPersonSubject


'' Detach が必要ない場合は，動的配列でも構いません。
Private m_observers As Collection
'

Private Sub Class_Initialize()
    Set m_observers = New Collection
End Sub

Private Sub Class_Terminate()
    Debug.Print "IPersonSubjectImpl: Class_Terminate."
End Sub

'' ISubject インターフェース
Private Sub ISubject_Attach(vntObserver As Variant)
    Dim observer As CPersonObserver
    '' 重複確認  --- 単にエラー処理でも可。
    For Each observer In m_observers
        If observer Is vntObserver Then
            Debug.Print "オブザーバーは登録済み。"
            Exit Sub
        End If
    Next
    Call m_observers.Add(vntObserver)
End Sub

Private Sub ISubject_Detach(vntObserver As Variant)
    Dim observer As CPersonObserver
    '' 登録済みのもののみ削除  --- 単にエラー処理でも可。
    For Each observer In m_observers
        If observer Is vntObserver Then
            Call m_observers.Remove(vntObserver)
            Exit Sub
        End If
    Next
    Debug.Print "未登録のオブザーバーに対して削除。"
End Sub

'' IPersonSubject インターフェース
Private Sub IPersonSubject_LevelChanging(clsPerson As CPerson, _
                                         lngNewLevel As Long, blnCancel As Boolean)
    Dim observer As CPersonObserver
    For Each observer In m_observers
        Call observer.LevelChanging(clsPerson, lngNewLevel, blnCancel)
    Next
End Sub

Private Sub IPersonSubject_LevelChanged(clsPerson As CPerson)
    Dim observer As CPersonObserver
    For Each observer In m_observers
        Call observer.LevelChanged(clsPerson)
    Next
End Sub

Option Explicit

Implements ISubject

Private m_personSubject As IPersonSubject


Private m_userName As String
Private m_level As Long
'

Public Property Let UserName(strValue As String)
    m_userName = strValue
End Property

Public Property Get UserName() As String
    UserName = m_userName
End Property

Public Property Let Level(ByVal lngValue As Long)
    If m_level <> lngValue Then
        If m_personSubject Is Nothing Then
            m_level = lngValue
            Exit Property
        End If
        Dim blnCancel As Boolean
        Call m_personSubject.LevelChanging(Me, lngValue, blnCancel)
        If Not blnCancel Then
            m_level = lngValue
            Call m_personSubject.LevelChanged(Me)
        End If
    End If
End Property

Public Property Get Level() As Long
    Level = m_level
End Property

Private Sub Class_Initialize()
    Set m_personSubject = New IPersonSubjectImpl
End Sub

Private Sub Class_Terminate()
    Debug.Print "CPerson - " & m_userName & ": Class_Terminate."
End Sub
 
'' ISubject インターフェース
Private Sub ISubject_Attach(vntObserver As Variant)
    Dim subject As ISubject
    Set subject = m_personSubject
    Call subject.Attach(vntObserver)
End Sub

Private Sub ISubject_Detach(vntObserver As Variant)
    Dim subject As ISubject
    Set subject = m_personSubject
    Call subject.Detach(vntObserver)
End Sub

Option Explicit

Private m_persons As Collection
'

Public Function Add(strUserName As String, _
                    Optional strDefaultLevel As Long = 3) As CPerson
    Dim clsPersons As CPersons
    Dim clsPerson As CPerson
    
    '' 重複確認 もしくは Add時にエラー処理で
    For Each clsPerson In m_persons
        If clsPerson.UserName = strUserName Then
            MsgBox "既にその名前は登録されています。"
            Exit Function
        End If
    Next

    Set clsPerson = New CPerson
    clsPerson.UserName = strUserName
    clsPerson.Level = strDefaultLevel
    Call m_persons.Add(clsPerson, strUserName)
    Set Add = clsPerson
End Function

Public Property Get Item(strUserName As String) As CPerson
    Set Item = m_persons.Item(strUserName)
End Property

Private Sub Class_Initialize()
    Set m_persons = New Collection
End Sub

Private Sub Class_Terminate()
    Debug.Print "CPersons: Class_Terminate."
End Sub

Option Explicit

Private m_clsPersons As CPersons
Private WithEvents m_clsObserver As CPersonObserver
'

Private Sub Class_Initialize()
    Dim clsObserver As CPersonObserver
    Dim itfSubject As ISubject
    Dim clsPersons As CPersons
    Dim vntElement As Variant
    
    Set clsObserver = New CPersonObserver
    Set clsPersons = New CPersons
    For Each vntElement In Array("yayadonさん", _
                                 "ろひさん", _
                                 "simpleさん", _
                                 "月さん", _
                                 "ゴマさん", _
                                 "kumattiさん", _
                                 "YU-TANGさん", _
                                 "Kanabunさん", _
                                 "Abyssさん", _
                                 "みそじのおじさん")
        Set itfSubject = clsPersons.Add(CStr(vntElement))
        Call itfSubject.Attach(clsObserver)
    Next
    Set m_clsPersons = clsPersons
    Set m_clsObserver = clsObserver
End Sub

Private Sub Class_Terminate()
    Debug.Print "CTestContainer: Class_Terminate."
End Sub

'' Test CPersons.Add
Public Sub TestAdd(strUserName As String, Optional strLevel As Long = 3)
    Call m_clsPersons.Add(strUserName)
End Sub

'' Test CPersons.Item
Public Function TestItem(strUserName As String) As CPerson
    Set TestItem = m_clsPersons.Item(strUserName)
End Function

Private Sub m_clsObserver_OnLevelChanging(clsPerson As CPerson, _
                                          lngNewLevel As Long, _
                                          blnCancel As Boolean)
    Dim result As VbMsgBoxResult
    Dim strMsg As String
    strMsg = clsPerson.UserName & "のレベルが" & vbCrLf & _
             clsPerson.Level & " から " & lngNewLevel & " に" & vbCrLf & _
             "変更されようとしています。" & vbCrLf & _
             "許可しますか？"
    result = MsgBox(strMsg, vbYesNo Or vbDefaultButton2 Or vbInformation, _
                    "変更の確認: ユーザーのレベル")
    If result = vbNo Then
        blnCancel = True
    End If
End Sub

Private Sub m_clsObserver_OnLevelChanged(clsPerson As CPerson)
    MsgBox clsPerson.UserName & " のレベルが " & _
           clsPerson.Level & " に変化しました。"
End Sub

Private Sub Test1()

    Dim clsTestContainer As CTestContainer
    Dim clsPerson As CPerson
    
    Debug.Print "Test 開始"
    
    Set clsTestContainer = New CTestContainer
    
    MsgBox "Test CPersons.Add"
    Call clsTestContainer.TestAdd("yayadonさん")
    
    MsgBox "Test CPersons.Item"
    Set clsPerson = clsTestContainer.TestItem("yayadonさん")
    
    MsgBox "Test CPerson.Level"
    clsPerson.Level = clsPerson.Level + 1
    
    MsgBox clsPerson.UserName & " の現在のレベルは " & _
           clsPerson.Level & " です。"
    
    Set clsPerson = Nothing
    Set clsTestContainer = Nothing
    
    MsgBox "終了"
    
    Debug.Print "Test 終了"
    
End Sub

みそじのおじさん さんの引用:

私も考えていますが、どなたか
・１つのクラスのみの構成で
・コードも短め
・実践的 or インパクトが強い
・クラスの魅力を伝えられる？！
 
を提示して頂けませんか？
クラスモジュールを扱う方の人口を増やすには、やはり「魅力」を伝えなければと
思っています^^

'*** 標準モジュール：modLogFile01 ***
'前提条件
'OpenLogは最初に１回だけ実行
'CloseLogは最後に１回だけ実行
'ファイル名固定
Option Explicit
Public Enum genmLogLevelM1
    ltm1Info
    ltm1Warn
    ltm1Error
End Enum
Private mlngFno As Long
Private menmLogLevel As genmLogLevelM1
'出力する最低レベルを設定
Public Sub OpenLog( _
penmLogLevel As genmLogLevelM1)
    menmLogLevel = penmLogLevel
    mlngFno = FreeFile
    'ファイル名固定
    Open ThisWorkbook.Path & _
        "\logM11.txt" _
        For Append As #mlngFno
End Sub
Public Sub WriteInfo( _
pstrText As String)
    If menmLogLevel > ltm1Info Then
        Exit Sub
    End If
    Call prvWriteLog("Info ", pstrText)
End Sub
Public Sub WriteWarn( _
pstrText As String, _
Optional pstrDetail)
    If menmLogLevel > ltm1Warn Then
        Exit Sub
    End If
    Call prvWriteLog( _
        "Warn ", _
        pstrText, _
        pstrDetail)
End Sub
Public Sub WriteError( _
pstrText As String, _
Optional pstrDetail)
    If menmLogLevel > ltm1Error Then
        Exit Sub
    End If
    Call prvWriteLog( _
        "Error", _
        pstrText, _
        pstrDetail)
End Sub
Public Sub CloseLog()
    Close #mlngFno
End Sub
Private Sub prvWriteLog( _
pstrLogLevel As String, _
pstrText As String, _
Optional pstrDetail)
    Print #mlngFno, _
        Format(Now, "yyyy/mm/dd hh:mm:ss") & _
        " [" & pstrLogLevel & "]" & pstrText
    If IsMissing(pstrDetail) = False Then
        Print #mlngFno, "   " & pstrDetail
    End If
End Sub

'*** 標準モジュール：modLogFile02 ***
'前提条件
'OpenLogは最初に１回だけ実行
'CloseLogは最初に１回だけ実行
'OpenLogで指定するファイル名はダブらない
'ファイル名可変
Option Explicit
Public Enum genmLogLevelM2
    ltm2Info
    ltm2Warn
    ltm2Error
End Enum
Private mlngFno As Long
Private menmLogLevel As genmLogLevelM2
'出力する最低レベルを設定
Public Sub OpenLog( _
pstrFileName As String, _
penmLogLevel As genmLogLevelM2)
    menmLogLevel = penmLogLevel
    mlngFno = FreeFile
    'ファイル名可変
    Open ThisWorkbook.Path & _
        "\" & pstrFileName _
        For Append As #mlngFno
End Sub
Public Sub WriteInfo( _
pstrText As String)
    If menmLogLevel > ltm2Info Then
        Exit Sub
    End If
    Call prvWriteLog("Info ", pstrText)
End Sub
Public Sub WriteWarn( _
pstrText As String, _
Optional pstrDetail)
    If menmLogLevel > ltm2Warn Then
        Exit Sub
    End If
    Call prvWriteLog( _
        "Warn ", _
        pstrText, _
        pstrDetail)
End Sub
Public Sub WriteError( _
pstrText As String, _
Optional pstrDetail)
    If menmLogLevel > ltm2Error Then
        Exit Sub
    End If
    Call prvWriteLog( _
        "Error", _
        pstrText, _
        pstrDetail)
End Sub
Public Sub CloseLog()
    Close #mlngFno
End Sub
Private Sub prvWriteLog( _
pstrLogLevel As String, _
pstrText As String, _
Optional pstrDetail)
    Print #mlngFno, _
        Format(Now, "yyyy/mm/dd hh:mm:ss") & _
        " [" & pstrLogLevel & "]" & pstrText
    If IsMissing(pstrDetail) = False Then
        Print #mlngFno, "   " & pstrDetail
    End If
End Sub

'*** クラスモジュール：clsLogFile01 ***
'前提条件
'OpenLogはインスタンスごとに最初に１回だけ実行
'CloseLogはインスタンスごとに最後に１回だけ実行
'ファイル名固定
Option Explicit
Public Enum genmLogLevelC1
    ltc1Info
    ltc1Warn
    ltc1Error
End Enum
Private mlngFno As Long
Private menmLogLevel As genmLogLevelC1
'出力する最低レベルを設定
Public Sub OpenLog( _
penmLogLevel As genmLogLevelC1)
    menmLogLevel = penmLogLevel
    mlngFno = FreeFile
    'ファイル名固定
    Open ThisWorkbook.Path & _
        "\logC11.txt" _
        For Append As #mlngFno
End Sub
Public Sub WriteInfo( _
pstrText As String)
    If menmLogLevel > ltc1Info Then
        Exit Sub
    End If
    Call prvWriteLog("Info ", pstrText)
End Sub
Public Sub WriteWarn( _
pstrText As String, _
Optional pstrDetail)
    If menmLogLevel > ltc1Warn Then
        Exit Sub
    End If
    Call prvWriteLog( _
        "Warn ", _
        pstrText, _
        pstrDetail)
End Sub
Public Sub WriteError( _
pstrText As String, _
Optional pstrDetail)
    If menmLogLevel > ltc1Error Then
        Exit Sub
    End If
    Call prvWriteLog( _
        "Error", _
        pstrText, _
        pstrDetail)
End Sub
Public Sub CloseLog()
    Close #mlngFno
End Sub
Private Sub prvWriteLog( _
pstrLogLevel As String, _
pstrText As String, _
Optional pstrDetail)
    Print #mlngFno, _
        Format(Now, "yyyy/mm/dd hh:mm:ss") & _
        " [" & pstrLogLevel & "]" & pstrText
    If IsMissing(pstrDetail) = False Then
        Print #mlngFno, "   " & pstrDetail
    End If
End Sub

'*** クラスモジュール：clsLogFile02 ***
'前提条件
'OpenLogはインスタンスごとに最初に１回だけ実行
'CloseLogはインスタンスごとに最初に１回だけ実行
'OpenLogで指定するファイル名はダブらない
'ファイル名可変
Option Explicit
Public Enum genmLogLevelC2
    ltc2Info
    ltc2Warn
    ltc2Error
End Enum
Private mlngFno As Long
Private menmLogLevel As genmLogLevelC2
'出力する最低レベルを設定
Public Sub OpenLog( _
pstrFileName As String, _
penmLogLevel As genmLogLevelC2)
    menmLogLevel = penmLogLevel
    mlngFno = FreeFile
    'ファイル名可変
    Open ThisWorkbook.Path & _
        "\" & pstrFileName _
        For Append As #mlngFno
End Sub
Public Sub WriteInfo( _
pstrText As String)
    If menmLogLevel > ltc2Info Then
        Exit Sub
    End If
    Call prvWriteLog("Info ", pstrText)
End Sub
Public Sub WriteWarn( _
pstrText As String, _
Optional pstrDetail)
    If menmLogLevel > ltc2Warn Then
        Exit Sub
    End If
    Call prvWriteLog( _
        "Warn ", _
        pstrText, _
        pstrDetail)
End Sub
Public Sub WriteError( _
pstrText As String, _
Optional pstrDetail)
    If menmLogLevel > ltc2Error Then
        Exit Sub
    End If
    Call prvWriteLog( _
        "Error", _
        pstrText, _
        pstrDetail)
End Sub
Public Sub CloseLog()
    Close #mlngFno
End Sub
Private Sub prvWriteLog( _
pstrLogLevel As String, _
pstrText As String, _
Optional pstrDetail)
    Print #mlngFno, _
        Format(Now, "yyyy/mm/dd hh:mm:ss") & _
        " [" & pstrLogLevel & "]" & pstrText
    If IsMissing(pstrDetail) = False Then
        Print #mlngFno, "   " & pstrDetail
    End If
End Sub

'*** 標準モジュール：ModuleM1 ***
'modLogFile01のテスト
Option Explicit
'テスト１（正常終了）
Sub testm11()
    Call modLogFile01.OpenLog(ltm1Info)
    Call modLogFile01.WriteInfo("001-1info")
    Call modLogFile01.WriteWarn("001-1Warn", "xxx")
    Call modLogFile01.WriteError("001-1Error", "xxx")
    Call modLogFile01.CloseLog
End Sub
'テスト２（エラー）
Sub testm12()
    Call modLogFile01.OpenLog(ltm1Info)
    Call modLogFile01.WriteInfo("001-1info")
    Call modLogFile01.WriteWarn("001-1Warn", "xxx")
    Call modLogFile01.WriteError("001-1Error", "xxx")
    Call testm12s1
    Call modLogFile01.WriteInfo("001-2info")
    Call modLogFile01.WriteWarn("001-2Warn", "xxx")
    Call modLogFile01.WriteError("001-2Error", "xxx")
    Call modLogFile01.CloseLog
End Sub
Sub testm12s1()
    'ファイルがすでにオープン済みでエラー
    Call modLogFile01.OpenLog(ltm1Warn) 'NG
    Call modLogFile01.WriteInfo("002-1info")
    Call modLogFile01.WriteWarn("002-1Warn", "xxx")
    Call modLogFile01.WriteError("002-1Error", "xxx")
    Call modLogFile01.CloseLog
End Sub
'テスト３（エラー）
Sub testm13()
    Call modLogFile01.OpenLog(ltm1Info)
    Call modLogFile01.WriteInfo("001-1info")
    Call modLogFile01.WriteWarn("001-1Warn", "xxx")
    Call modLogFile01.WriteError("001-1Error", "xxx")
    Call testm13s1
    Call modLogFile01.WriteInfo("001-2info")
    Call modLogFile01.WriteWarn("001-2Warn", "xxx")
    Call modLogFile01.WriteError("001-2Error", "xxx")
    Call modLogFile01.CloseLog
End Sub
Sub testm13s1()
    'ファイルがすでにオープン済みでエラー
    Call modLogFile01.OpenLog(ltm1Info) 'NG
    Call modLogFile01.WriteInfo("002-1info")
    Call modLogFile01.WriteWarn("002-1Warn", "xxx")
    Call modLogFile01.WriteError("002-1Error", "xxx")
    Call testm13s2
    Call modLogFile01.WriteInfo("002-2info")
    Call modLogFile01.WriteWarn("002-2Warn", "xxx")
    Call modLogFile01.WriteError("002-2Error", "xxx")
    Call modLogFile01.CloseLog
End Sub
Sub testm13s2()
    Call modLogFile01.OpenLog(ltm1Info)
    Call modLogFile01.WriteInfo("003-1info")
    Call modLogFile01.WriteWarn("003-1Warn", "xxx")
    Call modLogFile01.WriteError("003-1Error", "xxx")
    Call modLogFile01.CloseLog
End Sub

'*** 標準モジュール：ModuleM2 ***
'modLogFile02のテスト
Option Explicit
'テスト１（正常終了）
Sub testm21()
    Call modLogFile02.OpenLog("logM21a.txt", ltm2Info)
    Call modLogFile02.WriteInfo("001-1info")
    Call modLogFile02.WriteWarn("001-1Warn", "xxx")
    Call modLogFile02.WriteError("001-1Error", "xxx")
    Call modLogFile02.CloseLog
End Sub
'テスト２（エラー）
Sub testm22()
    Call modLogFile02.OpenLog("logM21a.txt", ltm2Info)
    Call modLogFile02.WriteInfo("001-1info")
    Call modLogFile02.WriteWarn("001-1Warn", "xxx")
    Call modLogFile02.WriteError("001-1Error", "xxx")
    Call testm22s1
    'クローズ後にテキスト出力しようとして
    'ファイル名またはファイル番号が不正でエラー
    Call modLogFile02.WriteInfo("001-2info") 'NG
    Call modLogFile02.WriteWarn("001-2Warn", "xxx")
    Call modLogFile02.WriteError("001-2Error", "xxx")
    Call modLogFile02.CloseLog
End Sub
Sub testm22s1()
    Call modLogFile02.OpenLog("logM21b.txt", ltm2Warn)
    Call modLogFile02.WriteInfo("002-1info")
    Call modLogFile02.WriteWarn("002-1Warn", "xxx")
    Call modLogFile02.WriteError("002-1Error", "xxx")
    Call modLogFile02.CloseLog
End Sub
'テスト３（エラー）
Sub testm23()
    Call modLogFile02.OpenLog("logM21a.txt", ltm2Info)
    Call modLogFile02.WriteInfo("001-1info")
    Call modLogFile02.WriteWarn("001-1Warn", "xxx")
    Call modLogFile02.WriteError("001-1Error", "xxx")
    Call testm23s1
    Call modLogFile02.WriteInfo("001-2info")
    Call modLogFile02.WriteWarn("001-2Warn", "xxx")
    Call modLogFile02.WriteError("001-2Error", "xxx")
    Call modLogFile02.CloseLog
End Sub
Sub testm23s1()
    Call modLogFile02.OpenLog("logM21b.txt", ltm2Warn)
    Call modLogFile02.WriteInfo("002-1info")
    Call modLogFile02.WriteWarn("002-1Warn", "xxx")
    Call modLogFile02.WriteError("002-1Error", "xxx")
    Call testm23s2
    'クローズ後にテキスト出力しようとして
    'ファイル名またはファイル番号が不正でエラー
    Call modLogFile02.WriteInfo("002-2info") 'NG
    Call modLogFile02.WriteWarn("002-2Warn", "xxx")
    Call modLogFile02.WriteError("002-2Error", "xxx")
    Call modLogFile02.CloseLog
End Sub
Sub testm23s2()
    Call modLogFile02.OpenLog("logM21c.txt", ltm2Error)
    Call modLogFile02.WriteInfo("003-1info")
    Call modLogFile02.WriteWarn("003-1Warn", "xxx")
    Call modLogFile02.WriteError("003-1Error", "xxx")
    Call modLogFile02.CloseLog
End Sub

'*** 標準モジュール：ModuleC1 ***
'clsLogFile01のテスト
Option Explicit
'テスト１（正常終了）
Sub testc11()
    Dim objLog As clsLogFile01
    Set objLog = New clsLogFile01
    Call objLog.OpenLog(ltc1Info)
    Call objLog.WriteInfo("001-1info")
    Call objLog.WriteWarn("001-1Warn", "xxx")
    Call objLog.WriteError("001-1Error", "xxx")
    Call objLog.CloseLog
End Sub
'テスト２（エラー）
Sub testc12()
    Dim objLog As clsLogFile01
    Set objLog = New clsLogFile01
    Call objLog.OpenLog(ltc1Info)
    Call objLog.WriteInfo("001-1info")
    Call objLog.WriteWarn("001-1Warn", "xxx")
    Call objLog.WriteError("001-1Error", "xxx")
    Call testc12s1
    Call objLog.WriteInfo("001-2info")
    Call objLog.WriteWarn("001-2Warn", "xxx")
    Call objLog.WriteError("001-2Error", "xxx")
    Call objLog.CloseLog
End Sub
Sub testc12s1()
    Dim objLog As clsLogFile01
    Set objLog = New clsLogFile01
    'ファイルがすでにオープン済みでエラー
    Call objLog.OpenLog(ltc1Warn) 'NG
    Call objLog.WriteInfo("002-1info")
    Call objLog.WriteWarn("002-1Warn", "xxx")
    Call objLog.WriteError("002-1Error", "xxx")
    Call objLog.CloseLog
End Sub
'テスト３（エラー）
Sub testc13()
    Dim objLog As clsLogFile01
    Set objLog = New clsLogFile01
    Call objLog.OpenLog(ltc1Info)
    Call objLog.WriteInfo("001-1info")
    Call objLog.WriteWarn("001-1Warn", "xxx")
    Call objLog.WriteError("001-1Error", "xxx")
    Call testc13s1
    Call objLog.WriteInfo("001-2info")
    Call objLog.WriteWarn("001-2Warn", "xxx")
    Call objLog.WriteError("001-2Error", "xxx")
    Call objLog.CloseLog
End Sub
Sub testc13s1()
    Dim objLog As clsLogFile01
    Set objLog = New clsLogFile01
    'ファイルがすでにオープン済みでエラー
    Call objLog.OpenLog(ltc1Info) 'NG
    Call objLog.WriteInfo("002-1info")
    Call objLog.WriteWarn("002-1Warn", "xxx")
    Call objLog.WriteError("002-1Error", "xxx")
    Call testc13s2
    Call objLog.WriteInfo("001-2info")
    Call objLog.WriteWarn("001-2Warn", "xxx")
    Call objLog.WriteError("001-2Error", "xxx")
    Call objLog.CloseLog
End Sub
Sub testc13s2()
    Dim objLog As clsLogFile01
    Set objLog = New clsLogFile01
    Call objLog.OpenLog(ltc1Info)
    Call objLog.WriteInfo("003-1info")
    Call objLog.WriteWarn("003-1Warn", "xxx")
    Call objLog.WriteError("003-1Error", "xxx")
    Call objLog.CloseLog
End Sub

'*** 標準モジュール：ModuleC2 ***
'clsLogFile02のテスト
Option Explicit
'テスト１（正常終了）
Sub testc21()
    Dim objLog As clsLogFile02
    Set objLog = New clsLogFile02
    Call objLog.OpenLog("logC21a.txt", ltc2Info)
    Call objLog.WriteInfo("001-1info")
    Call objLog.WriteWarn("001-1Warn", "xxx")
    Call objLog.WriteError("001-1Error", "xxx")
    Call objLog.CloseLog
End Sub
'テスト２（正常終了）
Sub testc22()
    Dim objLog As clsLogFile02
    Set objLog = New clsLogFile02
    Call objLog.OpenLog("logC21a.txt", ltc2Info)
    Call objLog.WriteInfo("001-1info")
    Call objLog.WriteWarn("001-1Warn", "xxx")
    Call objLog.WriteError("001-1Error", "xxx")
    Call testc22s1
    Call objLog.WriteInfo("001-2info") 'NG
    Call objLog.WriteWarn("001-2Warn", "xxx")
    Call objLog.WriteError("001-2Error", "xxx")
    Call objLog.CloseLog
End Sub
Sub testc22s1()
    Dim objLog As clsLogFile02
    Set objLog = New clsLogFile02
    Call objLog.OpenLog("logC21b.txt", ltc2Warn)
    Call objLog.WriteInfo("002-1info")
    Call objLog.WriteWarn("002-1Warn", "xxx")
    Call objLog.WriteError("002-1Error", "xxx")
    Call objLog.CloseLog
End Sub
'テスト３（正常終了）
Sub testc23()
    Dim objLog As clsLogFile02
    Set objLog = New clsLogFile02
    Call objLog.OpenLog("logC21a.txt", ltc2Info)
    Call objLog.WriteInfo("001-1info")
    Call objLog.WriteWarn("001-1Warn", "xxx")
    Call objLog.WriteError("001-1Error", "xxx")
    Call testc23s1
    Call objLog.WriteInfo("001-2info")
    Call objLog.WriteWarn("001-2Warn", "xxx")
    Call objLog.WriteError("001-2Error", "xxx")
    Call objLog.CloseLog
End Sub
Sub testc23s1()
    Dim objLog As clsLogFile02
    Set objLog = New clsLogFile02
    Call objLog.OpenLog("logC21b.txt", ltc2Warn)
    Call objLog.WriteInfo("002-1info")
    Call objLog.WriteWarn("002-1Warn", "xxx")
    Call objLog.WriteError("002-1Error", "xxx")
    Call testc23s2
    Call objLog.WriteInfo("002-2info") 'NG
    Call objLog.WriteWarn("002-2Warn", "xxx")
    Call objLog.WriteError("002-2Error", "xxx")
    Call objLog.CloseLog
End Sub
Sub testc23s2()
    Dim objLog As clsLogFile02
    Set objLog = New clsLogFile02
    Call objLog.OpenLog("logC21c.txt", ltc2Error)
    Call objLog.WriteInfo("003-1info")
    Call objLog.WriteWarn("003-1Warn", "xxx")
    Call objLog.WriteError("003-1Error", "xxx")
    Call objLog.CloseLog
End Sub

おはようございます。
 
yayadonさん。ありがとうございます。
正直本当に面食らいました^^;（月さん、私ワンパンチKOってとこです・・）
 
朝一からyayadonさんの解説を見ながら動きを追っていますが難しいです。
Implementsをまともに使えてなかった私にとって、とても巨大な山にみえます。
 
「デザインパターンにそってクラスを作成する」大きな目標が見えました。
 
デザインパターンをWikiさんで検索すると
http://ja.wikipedia.org/wiki/%E3%83%87%E3%82%B6%E3%82%A4%E3%83%B3%E3%83%91%E3%82%BF%E3%83%BC%E3%83%B3_(%E3%82%BD%E3%83%95%E3%83%88%E3%82%A6%E3%82%A7%E3%82%A2)
 
こんなに数があるんですね。VBAで表現しきれないパターンもかなりあるのかも知れませんが
勉強してみたいと思います。
yayadonさんに、もっとまともなコメントが出来るようがんばります！
 
▼皆様へ
 
話を振り出しに戻すつもりはないのですが、今一つ自分の中で結論がでませんので
皆様の考え、スタンスをお伺いします。
 
●「強参照は悪なのか？」
 
・私自身は解放の手順さえ間違わなければ、強参照は素直に理解しやすく書き易いと思っている
・参照の仕方はその案件によってケースバイケース？
・自分のレベルにあった書き方ならそれでいい？
・いや、レベルうんぬんではなくやはり強参照は避けるべき？
 
このスレッドで色々な書き方があるのを知り今後使っていこうと思っていますが
この辺りの皆様の考えを聞かせて頂けると非常に参考になります。

みそじのおじさん さんの引用:
●「強参照は悪なのか？」

みそじのおじさん さんの引用:
・私自身は解放の手順さえ間違わなければ、強参照は素直に理解しやすく書き易いと思っている

みそじのおじさん さんの引用:
・参照の仕方はその案件によってケースバイケース？
・自分のレベルにあった書き方ならそれでいい？
・いや、レベルうんぬんではなくやはり強参照は避けるべき？

引用:
●「強参照は悪なのか？」

月さん。ありがとうございます。
 

月 さんの引用:

私はどうしても、それなくせないの？と思ってしまうでしょうね。
みそじのおじさんがリーダー、私がメンバーで、その通りやってくれって言われても、それなくせないの？とコーディングの度に思うでしょうね。

もっと進んでからにしようと思ったけど…
（１）を見返す方がまだ多そうなので、現行化した改訂版を再掲します。
（※お題「強参照は悪なのか？」提示まで。構成や漏れ等、ご指摘ある方はお願いします。）
======================================================================
◆VBAクラス研究室（１）http://www.moug.net/faq/viewtopic.php?t=62306
◆VBAクラス研究室（２）http://www.moug.net/faq/viewtopic.php?t=62566
※茶文字は検索用です。
======================================================================
≪主な出来事≫
◆トピック開設：挨拶、テーマ掲示
┃12/02/25 10:30:52　みそじのおじさん
◆コレクションクラスの話題からの派生、作成/連携の例
┃【視覚的にグループ分けが出来るクラス】コード掲示
┃12/03/02 00:02:37　みそじのおじさん
┃┗正しい利用手順の掲示
┃　12/03/03 20:08:40　みそじのおじさん
◆階層構造の見直し、クラスはどういうメンバを持つべきか、を考えて修正
┃【みそじのおじさんのクラス(修正中)】コード提示
┃12/03/11 12:40:08　月さん
◆「強い参照｣の循環部分の指摘
┃12/03/13 06:21:22　yayadonさん
┃┗説明一部誤りに伴うイベントの再解説
┃　12/03/15 08:22:58　yayadonさん
◆【2クラス構成にした改訂版】コード提示
┃12/03/13 18:04:18　Abyssさん
┃┗コード利用の補足
┃　12/03/14 13:41:31　月さん
◆【メソッドをイベントに変更→親オブジェクト取得する共通イベント定義版】コード提示
┃12/03/15 12:11:17　月さん
┃┣━＜別ツリーへ＞━☆
┃┗◆【みそじのおじさんのクラス 月修正版】 - github:gist(月さん)
┃　　https://gist.github.com/1970700
◆各修正・改訂コードの方向性について補足
┃12/03/16 03:12:54　yayadonさん
◆[まとめ]（１）の議論のながれ
　12/03/18 03:04:49　角田さん
 
☆(親子クラス1:1)メソッドをイベントにせず親取得イベント実装
┃◇親オブジェクトへの参照を保持せずに〜参照を得る方法 - github:gist(月さん)
┃┃https://gist.github.com/2041685
┃┣参照のながれについて図解で確認
┃┃12/03/15 17:41:35　角田さん
┃┗回答と補足
┃　12/03/15 18:20:47　月さん
◆親子クラス1:nでのイベント実装
┃Observerパターン
┃12/03/17 07:25:16　yayadonさん
┃┃┗補足
┃┃　12/03/17 08:11:41 yayadonさん
┃┃　┣◇親オブジェクトへの参照を保持せずに〜参照を得る方法2 - github:gist(月さん)
┃┃　┃┃https://gist.github.com/2054643
┃┃　┃┗◇ILinkインターフェイス不使用版 - github:gist(月さん)
┃┃　┃　　https://gist.github.com/643df93dc39c44644afa
┃┃　┣参照のながれについて図解で確認 - github:gist(月さん)
┃┃　┃12/03/17 17:57:00　角田さん
┃┃　┗回答
┃┃　　12/03/17 21:36:45　月さん
┃┗Subjectクラスを別に用意する版
┃　12/03/19 10:36:10　yayadonさん
┃　┗修正分を含む再掲
┃　　12/03/19 12:46:51　yayadonさん
(仮)強参照は悪なのか？←(いまここ)
 
---------------------------------------------------------------------
≪テーマ別まとめ≫
●VBAにおけるクラスとそのメリットとは？ - 初学・復習向け
◇Visual Basic 6 クラスモジュール講座 - CavalierLab
http://homepage1.nifty.com/CavalierLab/lab/vb/clsmdl/index.html
◇疑似からの脱却 - AddinBox(角田さん)
http://www.h3.dion.ne.jp/~sakatsu/Breakthrough_P-Ctrl_Arrays.htm
◇クラスモジュールを使った究極のVBAプログラム - 旧moug(Webアーカイブ)(大村あつしさん)
http://web.archive.org/web/20071014002909/http://www.moug.net/skillup/opm/opm08-01.htm
◇コレクションクラスと列挙子(イテレータ)
VBAクラス研究室（１）｜12/02/27 01:20:12　yayadonさん
⇒Count/Item /_NewEnumのメンバー関係を「みかん箱からみかんを取り出すのは誰か？ 」で解説
 
 
●クラス作例 - クラスの魅力を知ろう！
◇[1クラス]ラベル点滅クラス - AddinBox(角田さん)
http://www.h3.dion.ne.jp/~sakatsu/Excel_Tips09.htm
◇[2クラス]タイマコントロールクラス - AddinBox(角田さん)
http://www.h3.dion.ne.jp/~sakatsu/Excel_Tips15.htm
◇[2クラス]Calendar Controlのクラス化
VBAクラス研究室（１）｜12/03/15 03:15:42 Abyssさん
◇[1クラス]ログファイル処理に見る標準/クラスモジュールの違い
VBAクラス研究室（２）｜12/03/19 23:35:52　どんきちさん
(※01:ログファイル名固定 - NG例, 02:ログファイル名可変 - OK例)
 
 
●こんなクラスを使っています！ - おすすめVBAクラス
◇nanbu/CSVParser - github
https://github.com/nanbu/CSVParser
◇nanbu/XArray - github
https://github.com/nanbu/XArray
◇honda0510/Google-Calendar-Library-for-VBA - github(月さん)
https://github.com/honda0510/Google-Calendar-Library-for-VBA
 
 
●VBAクラスの制限事項 - 欠点転ずれば可能性に繋がる
ほぼ全項の解決方法において、自他コードともに実装やデバッグ/テスト工数に影響します。
そのため、そもそもの基本として、他言語以上に全てにおいて「わかりやすい命名や構造化」が重要になるでしょう。
 
◇インスタンス作成時(コンストラクタ)に引数を渡せない
⇒Initメソッドを実装し、Newした後に呼んでもらう
【VBAで引数付きのコンストラクタを定義する方法】コード提示
12/03/05 21:21:35　どんきちさん
　さらにイベント中継クラスを実装する
　【参照関係が３階層のときのPublicなクラスの参照(1)】コード提示
　12/03/14 22:47:03　どんきちさん
　【参照関係が３階層のときのPublicなクラスの参照(2)】コード提示
　12/03/14 22:54:47　どんきちさん
 
＜多態性(ポリモーフィズム)の実装、イベントリスナーの設計が悩ましい＞
○WithEvents
【〜複数クラスの同形式イベントを１つのイベントプロシージャで受け取る（１）】コード提示
12/03/07 21:39:48　どんきちさん
【〜複数クラスの同形式イベントを１つのイベントプロシージャで受け取る（２）】コード提示
12/03/07 21:44:55　どんきちさん
○循環参照を回避するためのTearDownメソッド実装
⇒WindowsAPIの64bit対応をするなら、ポインタ操作なしのこの手法も必要
○TearDownメソッド不要のための「弱参照 (weak reference) 」
⇒ObjPtr()で値取得(Long型変数)し、利用時はObject型に代入してから使う
(※コレクション側がそれを扱うクラスよりも寿命が長いため、メンバとしてコレクションへの参照を保持しているクラス部分に適用)
【CWeakReferenceクラス】コード提示
12/03/04 05:35:00　yayadonさん
 
◇(組込み以外の)新規作成クラスへ別クラスを継承できない
(※いずれの方法もコンポジション(クラスのメソッドを呼び出すメソッド)と組み合わせて実装）
⇒インタフェース継承(Implements)の呼び出しは可能 …だが間接的ゆえ若干面倒
【Implementsを使用してメンバを隔離】コードの提示
12/03/06 21:31:51　YU-TANGさん
 
⇒実行時バインディング …VBA的だがコンパイラのエラーチェックが甘くなる
 
 
◇パッケージ(可視性を担保)できる手段が限定的
⇒Private,Publicに加え、Friendを活用
◆[進行中]Friendはダイレクトに呼び出される？VTable経由より高速？
　【Friendスコープのメソッドと速度について】コード提示
　12/03/06 12:39:36　Abyssさん
　┣さらなる解説　12/03/07 03:40:39　yayadonさん
　┃┣補足　12/03/07 04:42:58　yayadonさん
　┃┗さらなるテスト　12/03/07 13:35:31　Abyssさん
　┗内部でPrivateメソッド呼出しは不利？　12/03/16 03:52:11　yayadonさん
　　┣XPsp3-VB6での結果　12/03/16 04:04:01　Abyssさん
　　┣7x86-Ac2010/xl2002での結果　12/03/16 04:33:16　yayadonさん
　　┗確かにFriendが早い(ケースが多い)？　12/03/19 03:03:36　yayadonさん
 
⇒ブックを分けて「Instancing」値を2(PublicNotCreatable)にする … 被参照ブック/アドインが開いている必要アリ
 
◇リフレクション機能が限定的
⇒オブジェクトのクラス名取得(TypeName関数)
⇒オブジェクトのメソッド名からメソッド呼び出し(CallByName関数)
【VBAでクラスのインスタンスを生成するリフレクション機能を実現】コード提示
12/03/07 21:39:48　どんきちさん
 
◇情報隠蔽・カプセル化に縛りがある
［標準モジュール］クラススコープのメソッド・属性を定義
［クラス/フォームモジュール］インスタンススコープのメソッド・属性を定義
（※Privateであるべきクラススコープの属性をPublicにせざるを得ない）
【別プロジェクトのクラスの利用】コード提示
12/03/15 21:49:30　どんきちさん
 
◇オーバーロード(同名の関数やメソッドの多重定義)が出来ない
⇒疑似オーバーロード：引数を省略(Optional)、任意数の引数(ParamArray) … 多用すると可読性低下を招く
⇒引数をVariant型/Object型にする …VBA的だがコンパイラのエラーチェックが甘くなる
 
◇エラーオブジェクト(ErrObjectクラス)の機能が貧弱
 
 
●その他 - 紹介・検証、VBAクラス関連のトピックなど
◇参照設定とNewキーワードとCreateObject関数(月さん)
http://www.moug.net/faq/viewtopic.php?t=60032
◇何をカプセル化と呼ぶのか(Googleキャッシュ)(yamaV1.02βさん)
http://webcache.googleusercontent.com/search?q=cache:Ue2H4Sp3Iz0J:www.moug.net/faq/viewtopic.php%3Ft%3D60181+%E4%BD%95%E3%82%92%E3%82%AB%E3%83%97%E3%82%BB%E3%83%AB%E5%8C%96%E3%81%A8%E5%91%BC%E3%81%B6%E3%81%AE%E3%81%8B&cd=1&hl=ja&ct=clnk&gl=jp
◇CELLの値とリアルタイムに表示が連動するUserForm用コントロール(みそじのおじさん)
http://www.moug.net/faq/viewtopic.php?t=60582
◇VBAでメソッドチェーンの例 - github:gist(月さん)
https://gist.github.com/1956111
◇XArrayクラスでポリモーフィズム例 - github:gist(月さん)
https://gist.github.com/1196564
◇Letステートメント - PC研究室2nd｜11/10/22 05:36:15 yayadonさん
◇ByRef渡しとVariant型 - PC研究室2nd｜11/12/08 15:42:55 yayadonさん
◇列挙とブック（とシートとクラス）・・ - ExcelQ&Aさろん(VBA)(過去ログ)(井川はるきさん)
http://excelfactory.net/excelboard/excelvba/cfs.cgi?word=%97%F1%8B%93%82%C6%83u%83b%83N&andor=and&logs=14.txt
◇参照の引数は実引数のいわゆる別名として扱う
VBAクラス研究室（１）｜12/02/28 13:01:48 yayadonさん
◇イベントの場合は循環しているように見えてもOK
VBAクラス研究室（１）｜12/03/13 06:21:22 yayadonさん
◇クラス内でAddressOfに指定するプロシージャ - ExcelQ&Aさろん(VBA)(過去ログ)(みそじのおじさん)
http://excelfactory.net/excelboard/excelvba/cfs.cgi?word=143081&andor=and&logs=23.txt
---------------------------------------------------------------------

Friend メソッド内からの Private メソッド呼び出しの件です。
 
VB6 の ネイティブ コンパイル されたもの(.exe)だと，
テストが安定して行われるので，
以下のようなものを WinXP SP3 & VB6 SP6 で(速度優先で)作成しておいて，
Win 7 SP1 上で走らせてみました。
 
# 最適化されすぎないように引数や計算を入れています。
 
 

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Function PrivateMethod1(ByVal value As Long) As Long
    PrivateMethod1 = value + 1
End Function

Private Function PrivateMethod2(ByVal value As Long) As Long
    PrivateMethod2 = value + 2
End Function

Private Function PrivateMethod3(ByVal value As Long) As Long
    PrivateMethod3 = value + 3
End Function

Private Function PrivateMethod4(ByVal value As Long) As Long
    PrivateMethod4 = value + 4
End Function

Private Function PrivateMethod5(ByVal value As Long) As Long
    PrivateMethod5 = value + 5
End Function

Public Function PublicMethod(ByVal count As Long) As Long
    Dim result As Long
    
    result = PrivateMethod1(count)
    If count > 1 Then
        result = PrivateMethod2(result)
        If count > 2 Then
            result = PrivateMethod3(result)
            If count > 3 Then
                result = PrivateMethod4(result)
                If count > 4 Then
                    result = PrivateMethod5(result)
                End If
            End If
        End If
    End If
    
    PublicMethod = result
End Function

Friend Function FriendMethod(ByVal count As Long) As Long
    Dim result As Long
    
    result = PrivateMethod1(count)
    If count > 1 Then
        result = PrivateMethod2(result)
        If count > 2 Then
            result = PrivateMethod3(result)
            If count > 3 Then
                result = PrivateMethod4(result)
                If count > 4 Then
                    result = PrivateMethod5(result)
                End If
            End If
        End If
    End If
    
    FriendMethod = result
End Function

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7260
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   7260
   StartUpPosition =   3  'Windows の既定値
   Begin VB.CommandButton Command2 
      Caption         =   "Friend テスト"
      Height          =   585
      Left            =   4320
      TabIndex        =   3
      Top             =   1680
      Width           =   1680
   End
   Begin VB.TextBox Text2 
      Alignment       =   1  '右揃え
      Height          =   375
      Left            =   4320
      TabIndex        =   2
      Top             =   390
      Width           =   1680
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Public テスト"
      Height          =   615
      Left            =   4320
      TabIndex        =   1
      Top             =   960
      Width           =   1680
   End
   Begin VB.TextBox Text1 
      Height          =   2355
      Left            =   285
      MultiLine       =   -1  'True
      ScrollBars      =   2  '垂直
      TabIndex        =   0
      Top             =   330
      Width           =   3885
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub TestPublic(ByVal count As Long)

    Const cIterate = 30000000
    Dim t As Single
    Dim i As Long
    Dim c As Class1
    Dim result As Long
    
    Set c = New Class1
    t = Timer
    For i = 1 To cIterate
        result = c.PublicMethod(count)
    Next
'    Debug.Print Timer - t, "public"
    Dim strMsg As String
    strMsg = Timer - t & " --- " & "public"
    Text1.Text = Text1.Text & vbCrLf & strMsg

End Sub

Private Sub TestFriend(ByVal count As Long)

    Const cIterate = 30000000
    Dim t As Single
    Dim i As Long
    Dim c As Class1
    Dim result As Long
    
    Set c = New Class1
    t = Timer
    For i = 1 To cIterate
        result = c.FriendMethod(count)
    Next
'    Debug.Print Timer - t, "friend"
    Dim strResult As String
    strResult = Timer - t & " --- " & "friend"
    Text1.Text = Text1.Text & vbCrLf & strResult

End Sub

Private Sub Command1_Click()
    Dim result As Long
    Call TestPublic(CLng(Text2.Text))
End Sub

Private Sub Command2_Click()
    Dim result As Long
    Call TestFriend(CLng(Text2.Text))
End Sub

PrivateMehtod1
1.377664 --- public
0.3266641 --- friend

PrivateMehtod1 & PrivateMehtod2
1.498727 --- public
0.4272656 --- friend

PrivateMehtod1 & PrivateMehtod2 & PrivateMehtod3
1.567172 --- public
0.5237188 --- friend

PrivateMehtod1 & PrivateMehtod2 & PrivateMehtod3 % PrivateMehtod4
1.794203 --- public
0.6364297 --- friend

PrivateMehtod1 & PrivateMehtod2 & PrivateMehtod3 & PrivateMehtod4 & PrivateMehtod5
1.927836 --- public
0.7730156 --- friend

PrivateMehtod1
1.328734 --- public
0.3419531 --- friend
p/f = 1.328 / 0.341
     = 3.894

PrivateMehtod1 & PrivateMehtod2
1.492359 --- public
0.4240625 --- friend
p/f = 1.492 / 0.424
     = 3.518

PrivateMehtod1 & PrivateMehtod2 & PrivateMehtod1
1.561891 --- public
0.5341094 --- friend
p/f = 1.561 / 0.424
     = 2.923

PrivateMehtod1 & PrivateMehtod2 & PrivateMehtod1 & PrivateMehtod2
1.749344 --- public
0.6203437 --- friend
p/f = 1.749 / 0.424
     = 2.820

PrivateMehtod1 & PrivateMehtod2 & PrivateMehtod1 & PrivateMehtod2 & PrivateMehtod1
1.905297 --- public
0.7766719 --- friend
p/f = 1.905 / 0.776
     = 2.454

PrivateMehtod1
8.833688 --- public
9.171375 --- friend
p/f = 8.833 / 9.171
     = 0.963

PrivateMehtod1 & PrivateMehtod2
12.91161 --- public
13.68477 --- friend
p/f = 12.911 / 13.684
     = 0.943

PrivateMehtod1 & PrivateMehtod2 & PrivateMehtod1
18.11717 --- public
18.85539 --- friend
p/f = 18.117 / 18.855
     = 0.960
PrivateMehtod1 & PrivateMehtod2 & PrivateMehtod1 & PrivateMehtod2
21.813 --- public
22.21586 --- friend
p/f = 21.813 / 22.215
     = 0.981

PrivateMehtod1 & PrivateMehtod2 & PrivateMehtod1 & PrivateMehtod2 & PrivateMehtod1
27.13948 --- public
26.7383 --- friend
p/f = 27.139 / 26.738
     = 1.014

・VB6は無いのでVBAでテスト

9.664063 --- friend
8.957031 --- public

Officeでテストの場合、私の環境では
VBA6とVBA7の動作が異なる結果になります。
 
VBA6でのテストは「Friendの勝ち」、VBA7でのテストは
「Publicの勝ち」です。新しくVBA7が登場する際、内部的に何が
起きているのかは分かりませんが、今の段階での結果報告です。

参戦（笑）。
 
> ・何をクラスにするのか？みなさんの判断基準。
・一塊のものならクラスにすることを検討する。
・モジュールレベル変数を多々使う機能なら、クラスにすることを検討する。
モジュールレベル変数の寿命は、プロジェクトの開始から終了までで、通常だとブックを開いてから閉じるまでのすべての時間になり、常にメモリを占有し続ける。クラスなら、インスタンスの生成から破棄までとなってメモリを占有させないことが可能。そんなにメモリを気にすることはありませんが、精神衛生上いいかも。
また「一塊」と同じですがグルーピングの意味もあります。１つの標準モジュールに 100 個も変数があるなんて許せませんし、保守しやすいとは思えません。
 
 
> ・クラス化にするメリット
・プロシージャ名の衝突を回避できる。
・変数でプログラムを渡せる
上２つのメリットから、別バージョンや別形式のモジュールに入れ替えるのが簡単になる。
Dim rp As New Reporter
を
Dim rp As New Reporter2
とすれば、新しいバージョンに切り替えられる。標準モジュールではこうはいかない。
別形式というのは、たとえばシートから読み取ってグラフ化するプログラムを、シートから読み取るクラスと、グラフ化するクラスと、それをつなぐプロシージャの３つの構成にしたとき、シートの形が変わった時には変わったシートの形式に合うクラスを作って入れ替えればよい。
＃もちろん入れ替えずに引数で渡す手もある。
＃読み取りだけクラスで、あとは１つのプロシージャという構成もある。
＃このとき Implements を使わなくてもいい。VBA には実行時バインディングがあるから。
 
・初期化プロシージャや終了時プロシージャがある
変数の初期値がゼロや "" や Empty や Nothing 以外が欲しい時がある。
でも私も、引数をつけられるコンストラクタが欲しいです。コンストラクタ関数を別途作ったり、Init/Term メソッドを呼び出すのもね。まあ、循環参照の回避とかも面倒なので Init/Term とかでやりますが。
 
・粒度を上げられる→概念のコード化（後述）
カプセル化や「データとプログラムは一塊」、スコープや寿命、親子関係などいろいろ含みます。
 
> ・構造体や標準モジュールに機能別にまとめたプロシージャ郡では駄目なのか？
標準モジュールは応用が利かない。たとえば１つのファイルを扱う機能を標準モジュールにまとめた場合、あとから同時に複数のファイルを扱う必要がでてきた時にダメになる。クラスなら、インスタンスを２つにすれば良いだけ。
これを標準モジュールで回避する場合、「データとプロシージャは別物」として別々に管理する必要がある。標準モジュールにあるファイル関数を呼び出すときに、一々どのファイルか指定しなければならない（標準モジュールは外部メソッドの塊）。クラスなら当然「データとプログラムは一塊」としてインスタンスを管理すればよい。
 
同様に構造体も応用が利かない。ユーザー定義型は、コレクションに入れられないから並び替えすら面倒。バリアント変数にも入らない。機能の付け足しも出来ない。
 
たとえば
Public Type UserInfo
    FirstName
    LastName
End Type
と、名前の構造体がある時、FullName を作るのを別関数として作るのか？
 
(UserInfo.cls)
Private Type uUserInfo
    FirstName
    LastName
End Type
Private mp As uUserInfo
 
Public Property Get FullName() As String
    With mp
        FullName = .LastName & " " & .FirstName
    End With
End Property
 
...
 
クラスなら、こんな風に追加すればいい。このとき姓名の順番でフルネームを作っているけど、名前の形式（東洋 or 西洋）とかを持たせてフルネームの作り方を変えることも可能。
 
「粒度を上げられる」にも通じるけど、「こんな機能を足したい」というときに「なら、このクラスに作りましょう」と悩まずに出来る。まあクラスでも悩む時はありますが、標準モジュールだと悩むし（プロシージャ名の命名にすら悩む）、あとで作ったことを忘れて使わなくなったりするかもしれない。
＃クラスの場合、インスタンス名.FullName なんて使い方だから、プロシージャの命名も簡単。
 
ユーザー定義型と、ユーザー定義型用プロシージャをつなぐのはプログラマの努力以外の何者でもない。しかしクラスなら、同じクラスに書くことで自動的につながる。
 
プログラマの努力によって構造を維持するのではなく、言語の機能により構造が維持され、コンパイルチェックで適切か判断すらされる、このメリット。言語は、こういう方向に進化してきたし、しているし、プログラマはこの利点を教授すべきだし、教授して堅牢なプログラムを作るべき。
 
 
> ・他言語から見た、VBAのクラスの可能性や制限事項。
×継承がない
が、実際問題、継承がないのは別に構わない（JAVA も多重継承は捨てたし）。委譲は出来るから十分かな。
 
×静的メソッドや静的メンバーがない
これが無いために、クラスモジュールと、クラスやインスタンスを管理するための標準モジュールが必要になり、モジュール数の増大を引き起こす。
 
×リフレクションがない
あれば便利なのに。まあ、コード解析できるのでやってやれないことはないですが。
 
○実行時バインディングが基本
遅いですが、応用はしやすい。
コードでコードを書き換えて実行すら出来る（相当、危険な機能）。
Run メソッドとかもいいですね。
 
 
> VBAのクラスの話題が極端に少ない
 
このトピックは、たぶん「クラスをもっと使おう」ということなのでしょうが、なかなか難しいかなと思います。
 
マクロに興味を持った人は、
a.プログラムに興味がある
b.業務を簡単にすます技術（マクロ）があると知った
のどちらかだと思いますが、b の人が圧倒的に多いと思いますので。
 
業務の片手間に、クラスまで使うのは難しい気がします。クラスのサンプルが増えれば、手軽と言うか、クラスを使うのが当たり前になったりもするかもしれませんが、それも難しいかな。掲示板で書く分量を超えたりしますし。また掲示板で質問される方は、プロシージャの分割すらまずしませんから、「モジュールを２つ用意します」だけで拒否反応を示したり。「いや私はマクロの勉強がしたいのではなく、業務の効率化を行いたいんだ！」とか。(^^A)
 
クラスを使おうのが当たり前になるためには、
・対象業務のオブジェクト分析
・プログラムの構造設計
なんかが必要になると思うのですよ。でも、やられそうも無いですねぇ。
 
プロシージャの分割ぐらいは普通にやりましょう。そうすれば、モジュール２つにも拒否反応が出なくなるかもしれません。
 
 
昔、プログラムを習い始めるとフローチャートからやりましたが、今はまずやりません。そのくせ、いきなりクラスから始まります。これはプログラムの分割、構造設計が当然となっているわけで、フローなんて普通に分かるだろうと思われているわけです。
＃今だと、より上位の設計でフローが復活しているかな？
 
私は「クラスが必須」と考えていますが、これはプログラムは分割するものであり、するとプロシージャの数が膨大となり、これを分類整理し、かつ、プログラマの努力によってつなげるのではなく、自動的に確実に間違いなくつなげるためには「クラスしかない」という考えに至ったからです。クラスだとプロシージャ名が重複して良いから命名も楽ですしね。
 
また、プログラムをどう作るかと考えているとき、粒度を上げて概念で考えます。どうあるべきか。その頭の中にある概念を、可能な限り素直にコード化するにもクラスは必須です（クラスよりもっと現代的な機能があってももちろんイイですが、まあいいとして）。言語の機能により分割され、実行時には統合・連携して動作するのは、クラスでなければ無理でしょう。標準モジュールだと、自分で点検しないといけませんし。
 
掲示板で質問される方は、「取り出すには Instr と Mid で・・・」というレベルの方もいて、そういう人に高い粒度で話をするのは難しいです。
 
ちょっと、話が概念的すぎますかね。
 
 
どこかで書いた気もしますが、クラスを使う時は、以下で使うことになるかなぁと思います。
1.データのパッキング（機能付きデータ）
2.データの構造化（機能付き階層データ構造または集合）
3.単一機能のパッキング
4.アプリケーションの枠組み
 
1.は、あまり面白くないし、4.は掲示板で扱うのは無理な範囲なので、2.や 3.を出していけばいいのかな？
 
2.については、転記や集計がそれに当たるかなぁと思います。
 
転記を１つのプロシージャでやろうとする人が多いですが、それはかなり難しい。「入力×出力」のような掛け算的な複雑さになる。直接つなげずに「入力→○→出力」とすれば、かなり素直になる。
 
この○がクラスを使ったデータ構造体で、「本来こういうデータ構造であるべき」とか、「出力はこの形になるから、素直に集計できるその形のデータ構造があればいいのに」と思うときに、それを作ってしまうというのはよくやります。とは別の掲示板で書いた話。
 
例題を出されないと、書けない内容ですが。(^^A)
 
残るは 3.か。
 
 
> ・こんなクラスを使っています！
 
●MacroGuard
クラスの終了処理を使った例です。たいしたものではないですが。
 
簡単なマクロでの、最初に呼び出されるマクロに書いておきます。以下を行います。
・画面更新や割り込みの抑制
・エラーメッセージ
・［編集］-［繰り返し］コマンドへの登録
 
○使い方
Public Sub test()
    Dim mg As MacroGuard: Set mg = CreateMacroGuard("Test", "テスト", "ただのテストです。", True, True)
    Dim i As Long
    On Error GoTo ErrHandle
     
    If mg.Question("実行します。") = False Then Exit Sub
     
    i = 1 / 0
     
    Exit Sub
ErrHandle:
    Exit Sub
End Sub
 
○コンストラクタ関数
Public Function CreateMacroGuard(ByVal ProcName As String, _
                                 ByVal Caption As String, _
                                 Optional ByVal Description As String, _
                                 Optional ByVal LocksScreenUpdating As Boolean = False, _
                                 Optional ByVal SetsOnRepeat As Boolean = False, _
                                 Optional ByVal ReportsError As Boolean = True) As MacroGuard
    Set CreateMacroGuard = New MacroGuard
     
    CreateMacroGuard.Init ProcName, _
                          Caption, _
                          Description, _
                          LocksScreenUpdating, _
                          SetsOnRepeat, _
                          ReportsError
End Function
 
○クラス本体
' @(h) MacroGuard.cls ver 1.1 ( '00.00.00 藤代　千尋 )
 
' @(s)
' 目的：マクロ Sub プロシージャを統一的に処理するクラス。
' マクロで必要な処理を追加します。
' ・プロシージャ名、マクロ名、説明の登録
' ・［編集］-［繰り返し］コマンドへの登録
' ・画面更新、割り込みの抑制
' ・エラーの報告
'
' 設定はすべて Init で行います。各処理は、Init 時、もしくはインスタンスの破棄時に行われます。
'
' エラーをトラップする機能はありませんので、On Error と合わせて使用します。エラー報告を行う場合、
' エラーが発生していれば常に報告を行います。意図して出したエラーは、Err.Clear で消してください。
'
' インターフェース：
' 　・プロパティ
' ProcName プロシージャ名。
' Caption マクロ名。
' Description 説明。
' SetsOnRepeat ［編集］-［繰り返し］コマンドへの登録するか。
' ReportsError エラーの報告を行うか。
' 　・メソッド
' Init 初期化。
' Information 登録情報を使って、情報メッセージボックスを表示。
' Question 登録情報を使って、OK/キャンセルのメッセージボックスを表示。
' Exclamation 登録情報を使って、警告メッセージボックスを表示。
' 　・イベント
'
' 依存関係：
'
' 問題点：
'
' 改善点：
'
' 方法：
'
Option Explicit
 
Private Type UMacroGuard
    ProcName As String
    Caption As String
    Description As String
     
    SetsOnRepeat As Boolean
    ReportsError As Boolean
End Type
Private mp As UMacroGuard
 
Public Sub Init(ByVal ProcName As String, ByVal Caption As String, _
                ByVal Description As String, _
                ByVal LocksScreenUpdating As Boolean, _
                ByVal SetsOnRepeat As Boolean, _
                ByVal ReportsError As Boolean)
    With mp
        .ProcName = ProcName
        .Caption = Caption
        .Description = Description
         
        .SetsOnRepeat = SetsOnRepeat
        .ReportsError = ReportsError
    End With
    If LocksScreenUpdating Then
        Application.ScreenUpdating = False
        Application.EnableCancelKey = xlDisabled
    End If
End Sub
Private Sub Class_Terminate()
    Dim sMsg As String
 
    If Not (Application.ScreenUpdating = True) Then Application.ScreenUpdating = True
    If Not (Application.EnableCancelKey = xlInterrupt) Then Application.EnableCancelKey = xlInterrupt
     
    With mp
        If .SetsOnRepeat Then
            Application.OnRepeat .Caption, .ProcName
        End If
         
        If .ReportsError And Err.Number <> 0 Then
            sMsg = ""
            sMsg = sMsg & "処理中に以下のエラーが発生しました。" & vbCrLf & vbCrLf
            sMsg = sMsg & Err.Description
            Exclamation sMsg
        End If
    End With
End Sub
 
Public Sub Information(ByVal Prompt As String, Optional ByVal ShowDescription As Boolean = True)
    message Prompt, vbInformation, ShowDescription
End Sub
Public Function Question(ByVal Prompt As String, Optional ByVal ShowDescription As Boolean = True) As Boolean
    Question = (vbOK = message(Prompt, vbOKCancel & vbQuestion, ShowDescription))
End Function
Public Sub Exclamation(ByVal Prompt As String, Optional ByVal ShowDescription As Boolean = True)
    message Prompt, vbExclamation, ShowDescription
End Sub
Private Function message(ByVal Prompt As String, ByVal Buttons As Long, ByVal ShowDescription As Boolean) As Long
    With mp
        If .Description <> "" And ShowDescription Then
            Prompt = Prompt & vbCrLf & vbCrLf
            Prompt = Prompt & "■説明：" & .Caption & "■" & .Description
        End If
             
        message = MsgBox(Prompt, Buttons, .Caption & " [" & .ProcName & "]")
    End With
End Function
 
Public Property Get ProcName() As String
    ProcName = mp.ProcName
End Property
Public Property Get Caption() As String
    Caption = mp.Caption
End Property
Public Property Get Description() As String
    Description = mp.Description
End Property
Public Property Get SetsOnRepeat() As Boolean
    SetsOnRepeat = mp.SetsOnRepeat
End Property
Public Property Get ReportsError() As Boolean
    ReportsError = mp.ReportsError
End Property
 
これをさらに作り込んで、プロシージャの実行トレースとかプロファイリングが出来るように・・・と考えたりもしましたが、面倒なので止めました。
 
●XLOra
Oracle のコネクションとデータベースとレコードセットをクラス１つで管理するクラス。レコードセットとして .Value や .MoveNext は公開されているので、レコードセットのように扱えるインスタンスで、それに上位管理オブジェクトが含まれた感じ。
カプセル化により Null ←→ Empty を自動変換。テーブルをそのままシートに書き出したり、縦横回転させて書き出す機能あり。
簡単なデータベースアクセスならこれ１つで済むので楽。
 
コードは対象者が少ないと思われるので省略。

みなさん、こんばんは。
 
▼Abyssさん
「弱参照はVBランタイムを騙す行為」
 
Private Function ObjFromPtr(ByVal ptr&) As clsContainer
    Dim tmp As clsContainer
    MoveMemory tmp, ptr, 4
    Set ObjFromPtr = tmp　↑ここまでの使い方はOK
    MoveMemory tmp, 0&, 4　←この行為がはっきり理屈で理解出来ていない
End Function
 
MoveMemoryは今まで何回か使った事がありますが、上記の部分の仕組みをはっきり
理解出来ていない為（yayadonさんからの説明がありましたが）使用するのに
ためらいが少しあります。私のモットーで「しっかり理解出来ない物は自プロジェクト
に組み込むな！」とやっておりますので、、雛形的に使わせて頂けばいいのかもしれま
せんが。。騙したつもりが私自身に返ってくる可能性が大です^^;
貴重なご意見ありがとうございます。
 
▼藤代さん
 
「ログインの必要なmougに藤代さんは来て頂けないんだろうな。」と思っておりました。
いつものサイトにお呼びに行こうかと思っていた位です。（お呼びする為だけの
スレッドなんか立ち上げたら皆様に怒られてしまいますので、諦めていました）
本当にご参加ありがとうございます。
 
moug初参戦の藤代さんですが、VB板ではとても有名な方ですのでみなさんご存知では
ないでしょうか？私は、プロのプログラマである藤代さんから沢山の事を教えて頂いて
おります。（藤代さんのお名前で検索し、回答を読み漁ったりしておりました。）
藤代さんにクラスモジュールの件で回答頂いたのが２年弱前くらいでしたが
私成長できていますか？（笑）
 
素人の私が立ち上げるには力不足だったと思われる重い内容のスレッドでしたが
引き続きご支援をよろしくお願い致します。
 
# 私は完全に「a」の人です！！

> MoveMemory tmp, 0&, 4　←この行為がはっきり理屈で理解出来ていない
 
C++で書くとこんな感じでしょうか。

	DWORD dwTmp = NULL;
	LPDWORD pdwTmp = &dwTmp;
	LPDISPATCH *ppDisp = (LPDISPATCH*)pdwTmp;

藤代千尋さん、勉強になりました。
藤代千尋さんの回答がまたモーグで読めることを楽しみに待ちたいと思います。
MacroGuard、便利そうです。
 
@(h)は何記法なんだろうと思って検索したら、おっとっとーでした。

Private Function ObjFromPtr(ByVal ptr&) As clsContainer 
    Dim tmp As clsContainer 
    MoveMemory tmp, ptr, 4 
    Set ObjFromPtr = tmp　↑ここまでの使い方はOK 
    MoveMemory tmp, 0&, 4　←この行為がはっきり理屈で理解出来ていない 
End Function 

> tmp変数の開放が行われ(Release)
 
この表現は誤解を招く危険性がありますね。すみません。正しくは、
「tmp変数が参照しているclsContainerオブジェクトの開放が行われ...」

# 十分な説明が付いてるけど，せっかく書いたので，投稿しておきます。
 
というのは，
まず，MoveMemory で躓く人もいると思うので，そこから行きます。
 
 

    MoveMemory tmp, 0&, 4　    ' ←この行為がはっきり理屈で理解出来ていない
End Function

    Dim lngNullPointer As Long
    lngNullPointer = 0
    MoveMemory tmp, lngNullPointer, 4
End Function

tmp = 0

MoveMemory tmp, ptr, 4

Private Function ObjFromPtr(ByVal ptr As Long) As clsContainer
    Dim tmp As clsContainer

    MsgBox ObjPtr(tmp)                  ' 0
    MoveMemory tmp, ptr, 4              ' 最初の騙し
    MsgBox ObjPtr(tmp)                  ' 渡されたアドレス値 つまり 0 でない。

    MsgBox ObjPtr(ObjFromPtr)           ' 0
    Set ObjFromPtr = tmp                ' 参照カウントは +1
    MsgBox ObjPtr(ObjFromPtr)           ' 渡されたアドレス値 つまり 0 でない。

    ' この地点で，対象のオブジェクト(clsContainer のインスタンス)は，少なくとも，
    ' tmp と ObjFromPtr の ２つ のオブジェクト変数から参照されている。

    Dim lngNullPointer As Long
    lngNullPointer = 0
    MoveMemory tmp, lngNullPointer, 4   ' ２度目の騙し
    MsgBox ObjPtr(tmp)                  ' 0 になる。
End Function                            ' <---- A

補足: 参照カウント

Dim tmp1 As Class1
Dim tmp2 As Class1
Dim tmp3 As stdole.IUnknown

Set tmp1 = New Class1          ' A
Set tmp2 = tmp1                ' B
Set tmp3 = tmp1                ' C
With tmp1                      ' D
End With                       ' E

 A では，New 時にあらかじめ COM オブジェクト側が +1 して渡してくるので，
　 ここでの Set tmp1 = は +1 されません。

 B では，Set tmp2 = は +1 されます。

 C では，インターフェースを IUnknown に変えるために，
　 COM オブジェクトに対して QueryInterface メソッドというものを呼び出すのですが，
　 これも，COM オブジェクト側が，前もって +1 して渡してくるので，
　 Set tmp3 = は +1 されません。
 D の With tmp1 では +1 されて
 E の End With で -1 されます。

Set ObjFromPtr = tmp

Function ObjFromPtr(ByVal ptr As Long) As clsContainer

Function ObjFromPtr(ByVal ptr As Long, ByRef ObjFromPtr As clsContainer) As Long

Set ObjFromPtr = tmp

みなさん、こんばんは。
 
kumattiさん、月さん、Abyssさん、yayadonさん。
MoveMemoryの件ありがとうございます^^
ここまで詳しく解説を頂けましたら後は実践のみです。「弱参照」を自分の物に出来るよう
繰り返し練習してみます。
 
実は数ヶ月前に、MoveMemoryにコテンパンにやられていました^^;
（１）の冒頭に書きました、WorkSheetをRecordset風に扱うクラス内の処理で
 
・Recordsetのデータ元となるワークシートの範囲をバリアントで受ける
 
・配列の添え字が「１」スタートなのが気に入らなくて、自前で用意した２次元配列
　に高速で落としこみたくMoveMemoryを使ってチャレンジしてみました。
 
（何をするにも、-1のオフセットが必要だった為です。こんな事を書くと怒られるかも
しれませんが、私は「配列の添え字は0スタートが絶対！」派でしてOption Base 1 なんて書かれ
ているサンプルコードは読むきも起きないのです。。LBoundを使えば？と言われるかも
しれませんが、配列の添え字が１スタートの物があるなんて言語はVB位ではないのでしょうか？）
 
一次元配列での練習はうまくいきましたが、二次元配列になったとたんお手上げでした^^;
Excel君は悲鳴を上げるわけでもなく、だまって何十回も落ちていきました。
メモリ操作はやっぱり危険ですね。
結局MoveMemoryを諦めて（諦めたくなかったですが）、地道にループして落としこむといった方
法に変更しました。それ以来MoveMemoryには若干の拒絶反応が出ていました(笑）
「恐るべしMoveMemory！」ですね。
 
# 藤代さんは以前にはmougにいらしていたのですね。全然知りませんでした。
# 失礼しました。

こんばんは。
藤代さんのコメント勉強になります。ありがとうございました。
 
さて、先日はスレ主さんから励ましをいただき、ありがとうございました。
流れを断ち切って恐縮ですが、お言葉に甘えて、Ruby言語による、
Observerパターンのコード例を示してみます。
== 別言語なので、お時間の無い方は、全面的にスキップ下さい。=====
 
# coding: Windows-31J

module Subject
   def initialize
      @observers=[]
   end
   def add_observer(&observer)
      @observers << observer
   end
   def delete_observer(observer)
      @observers.delete(observer)
   end
   def notify_observers
      @observers.each do |observer|
         observer.call(self)
      end
   end
end

class Person
   include Subject
   attr_accessor :name
   attr_reader   :level
   
   def initialize(name,level)
      super()
      @name  = name
      @level = level
   end

   def level=(new_level)
      unless @level == new_level
         @level = new_level
         notify_observers
      end
   end
end

class MougPersons
   attr_reader :persons

   def initialize
      members = %w(yayadonさん ろひさん simpleさん 月さん ゴマさん
        kumattiさん  YU-TANGさん kanabunさん Abyssさん みそじのおじさん)
      # ↑ 文字列の配列です。  
      @persons = []
      @hash    = {}
      members.each do |member|
         myPerson =  Person.new(member,3)
         @persons << myPerson
         @hash[member] = myPerson
      end
   end
   def set_observer
      @persons.each do |myPerson|
         myPerson.add_observer do |changed_person|
            puts "#{changed_person.name}は #{changed_person.level} に" +
                 "レベル変更"
         end
      end
   end   
   def [](index)
      case index
      when Fixnum
         @persons[index]
      when String
         @hash[index]
      end
   end
end

  moug_persons = MougPersons.new
  moug_persons.set_observer
  moug_persons[0].level            = 4
  moug_persons["simpleさん"].level = 1
  moug_persons.persons.each do |mem|
     puts "#{mem.level} : #{mem.name} "
  end

yayadonさんは 4 にレベル変更
simpleさんは 1 にレベル変更
4 : yayadonさん 
3 : ろひさん 
1 : simpleさん 
3 : 月さん 
3 : ゴマさん 
3 : kumattiさん 
3 : YU-TANGさん 
3 : kanabunさん 
3 : Abyssさん 
3 : みそじのおじさん 

attr_reader   :level

   def level 
       @level
   end

attr_accessor :name 

   def neme=(new_name)
       @name = new_name
   end
   def name
       @name
   end

# 話を交錯させるようで、申し訳ないです。

引用:
・配列の添え字が「１」スタートなのが気に入らなくて、

kumatti さん，Abyss さん
検証ありがとうございました。
私には手におえなそうなので，
またなにか情報があったらの機会にお願いします。
 

kumatti さんの引用:
> (件のテクニックで、VirtualAlloc が必須になったぐらいで)

> 投稿日時: 12/03/22 08:57:38 No.61
(追記)
RtlMoveMemoryの宣言で第一、第二引数ともByRef As Anyなので、
(VBAだから)一時変数が作られ、
https://gist.github.com/2165075
なのかなと思ってます。
 
---
> 投稿日時: 12/03/21 11:52:48 No.58
 
AbyssさんのVBA6とVBA7で違いがあるのは
知りませんでした。
(件のテクニックで、VirtualAlloc が必須になったぐらいで)
 
> 投稿日時: 12/03/18 14:47:00 No.40
 
角田さんの「７セグメント」デジタル時計は動作確認しました。
鮮やかな出来でプロの仕事って感じです。
昔のスレ「タイマーコントロール作成」(だったかな)以来、
久し振りに拝見しました。
(弱参照やマシン語(Implementsの)など、私にとってはルーツの様なスレッドでした)

> よかったら，何の件なのか，ヒントくださ〜い。
 
配列にマシン語収めたままで可能なのは、
VBA6までで、VBA7以降はVirtualAlloc で実行可能属性を持たせた領域にコピーして、
そちらを指定しないとNG。
(Abyssさんが発見しました)

ようは、VBA7以降は「DEP有効」が初期設定されている
という事ですかね。

ありがとうごさいます。 > kumatti さん，Abyss さん
メモっときます。
　
　

そういえば、Excel 2007からFileSearchオブジェクトが使えなくなったんですよね。
 
代替クラスがあれば喜ばれるんじゃないかなー
 
というネタ振り。

みなさん、こんばんは。
やっと仕事が落ち着き久々の連休です^^これでじっくり取り組む事ができます。
 
▼どんきちさん
　すっかりお礼が遅くなりました。すみません。
　試して頂いた方には、「クラスを使う意義」を感じて貰えたのではないでしょうか。
 
▼simpleさん

simple さんの引用:

関係のないクラス間で、コードを共有したいときなどは、
メソッドの集合であるModuleをPersonにincludeすることで、
継承関係を使わずに、クラスに機能を混ぜ込むことができます。
Moduleは多重継承を避けつつ、同様の機能を果たすための方法と
見ることもできます。

> FileSearch
 
メソッドの並びを崩したくなかったので空実装みたくなってるけど、
実際は起動時のどこかのタイミングで差し替えてる(フックしてる)と考えて
なのでアンフックすれば使えると思ったが、
vtbl上のアドレスに規則性を見つけられないので結局、よく分からないと言う有様。
https://gist.github.com/2176573

> メソッドの並びを崩したくなかったので
 
一連のApplication.dummyが正にその典型か。

kumatti さんの引用:
メソッドの並びを崩したくなかったので空実装みたくなってるけど、
実際は起動時のどこかのタイミングで差し替えてる(フックしてる)と考えて
なのでアンフックすれば使えると思ったが、

みなさん、こんばんは。
 
話題が少し落ち着いた様ですので、私の方から１つよろしいでしょうか。
 
●継承について
・「皆様がよく使うRangeオブジェクトの機能を拡張してみよう！」を例に
 
 
 
VBAのクラスモジュールが貧弱だと言われる最大のデメリット「継承が出来ない」
を「考え方やテクニックで何とかカバー出来ないか！」というのがこの話題の趣旨です。
皆様よろしくお願い致します。
 
VBAでは、クラスの継承がサポートされておりません。Implementsによるインターフェース
のみの継承となっております。
ちょっと以前に書きました「皆様がよく使うRangeオブジェクトの機能を拡張してみよう！」
とやっていましたが、１つのクラスだけを使ってRangeオブジェクトを拡張しようとします
とRangeオブジェクトの全てのメンバをラップし、追加したいメソッドやプロパティを作成
するといった方法になると思います。
これは現実的な方法とは思えません。（Dictionaryくらいのメンバの数ならいいですが、、）
 
.netですとクラスの継承がサポートされていますので

Public RangeExClass
    Inherits Range　''Rangeクラスを継承する
    
　　Public Sub 独自のメソッド(Byval ・・・)
        ・・・
    End Sub

　　''Rangeクラス（BaseClass)のメソッドに変更を加える
    Public Overrides Sub Rangeのメソッド(ByVal ・・・・)
        ・・・
    End Sub

RangeExClass

　　Public Sub 独自のメソッド(Byval ・・・)
        ・・・
    End Sub

    ''Rangeオブジェクトのメンバを以下に全て列挙
    Public Property Get Value() As Variant
        ・・・・    
    End Property

    Public Property Let Value(Byval NewValue As Variant)
        ・・・・    
    End Property
    
　　以下延々とRangeオブジェクトが持つメンバすべてを書かなければいけない

ではコードです。
今回も規定のメンバを作成していますので、２つのクラスをエクスポート後に解放して
下さい。今回はメモ帳の必要はありません。文字が赤くハイライトされますがそのまま
無視してエクスポートして下さい。再び２つのクラスをインポートすれば作業完了です。
 
コンストラクタ関数にはRangeExクラスをどのシートが対象になるか指定して下さい。
Activeシートでいいなら指定は不要です。（例　CreateRangeEx(WorksSheets(2))　）
 
標準モジュールです。

Option Explicit
''コンストラクタ関数
''すぐ影響を受ける私です^^藤代さん、ありがとうございます。
Public Function CreateRangeEx(Optional ParentSheet As _
                                             Worksheet = Nothing) As RangeExClass
    
    Set CreateRangeEx = New RangeExClass
    
    ''Rangeの親の指定がなければActiveSheetを親に
    If ParentSheet Is Nothing Then
        Set ParentSheet = ActiveSheet
    End If
    
    CreateRangeEx.Init ParentSheet
    
End Function

''テストデータ作成プロシージャ
Sub CreateTestData()

    
    Dim wh      As Worksheet
    Dim r       As Range
    Dim i       As Integer
    Dim Menbers As Variant
    
        Set wh = Worksheets(1)
        Menbers = Array("yayadonさん", _
                        "ろひさん", _
                        "simpleさん", _
                        "月さん", _
                        "ゴマさん", _
                        "kumattiさん", _
                        "YU-TANGさん", _
                        "Kanabunさん", _
                        "Abyssさん", _
                        "みそじのおじさん", _
                        "どんきちさん", _
                        "マコさん", _
                        "ふるふるさん", _
                        "だるまさん", _
                        "yamaさん")

        Randomize Now()
        
        For Each r In wh.Range("A1:D4")
            ''Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
            i = Int((UBound(Menbers) - LBound(Menbers) + 1) * Rnd + LBound(Menbers))
            r.Value = Menbers(i)
        Next
        
        For Each r In wh.Range("F1:I4")
            ''Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
            i = Int((100 - 0 + 1) * Rnd + 0)
            r.Value = i
        Next
        
        wh.Range("A10").Value = "Sample1"
        wh.Range("A11").Value = "Sample2"
        wh.Columns("A:D").AutoFit
End Sub

Sub Sample()
    
    Dim Persons As Variant
    Dim RangeEx As RangeExClass: Set RangeEx = CreateRangeEx()
        
        ''テストデータ作成
        Call CreateTestData
        
        ''指定範囲のユニークなデータ取得
        ''UniqueValueプロパティ
        Persons = RangeEx("A1:D4").UniqueValue
        MsgBox "重複しないリスト:" & vbLf & Join(Persons, vbLf)
        
        ''CountIfプロパティ
        MsgBox Range("A1").Value & "は, " _
        & RangeEx("A1:D4").CountIf(Range("A1")) & "回出現しています"
        
        ''Averageプロパティ
        MsgBox "F1:I4の平均は," & RangeEx("F1:I4").Average & "です"
        
        ''Sumプロパティ
        MsgBox "F1:I4の合計は" & RangeEx("F1:I4").Sum & "です"
        
        ''StrConvExecuteメソッド
        MsgBox "vbWideでStrConvを実行します。", vbInformation
        RangeEx("A1:D4").StrConvExecute vbWide
        
        ''RunCmdメソッド
        MsgBox "セルに記入したマクロを実行します", vbInformation
        RangeEx("A10:A11").RunCmd True
        
        ''.Item.****で従来のRangeオブジェクトのメンバの参照可
        MsgBox "RangeEx(""A1:D4"").Item.Addressの構文が正しく働くか確認します"
        MsgBox RangeEx("A1:D4").Item.Address
        
        ''RangeEx("A1:D4").Item この後に「.」を打ってRangeオブジェクト
        ''のメンバの一覧が出てくる事を確認して下さい^^
        
        
End Sub

Sub Sample1()
    MsgBox "Sample1を実行しました。", vbInformation
End Sub

Sub Sample2()
    MsgBox "Sample2を実行しました。", vbInformation
End Sub

Option Explicit

''Partsクラスのイベントを受けとる為、WithEvents宣言
Private WithEvents mParts As RangeExPartsClass

Private mRangeParent As Worksheet ''Rangeの親シート
Private mRange       As Range     ''対象Range
Private mInitialized As Boolean   ''初期化完了フラグ

Private Sub Class_Initialize()
    mInitialized = False
End Sub

Private Sub Class_Terminate()
    'MsgBox "RangeExClass_Term!"
End Sub
''コンストラクタ
Public Sub Init(ByVal NewRangeParent As Worksheet)
    
    ''Partsクラスの生成
    Set mRangeParent = NewRangeParent
    
    ''初期化完了
    mInitialized = True
End Sub

''このクラスの規定のプロパティItem
Public Property Get Item(Cell1, Optional Cell2) As RangeExPartsClass
Attribute Item.VB_UserMemId = 0

    If Not mInitialized Then
        MsgBox "初期化が完了していません", vbExclamation
        Exit Property
    End If
    
    
    Set mParts = New RangeExPartsClass
    Set Item = mParts
    
    ''モジュールレベルの変数mRangeにRangeを確保
    If IsMissing(Cell2) Then
        Set mRange = mRangeParent.Range(Cell1)
    Else
        Set mRange = mRangeParent.Range(Cell1, Cell2)
    End If
    
End Property

''子クラスのイベント
''ByRefによってRangeを返します。
Private Sub mParts_GetParentRange(ParentRange As Range)
    Set ParentRange = mRange
End Sub

Option Explicit

Public Event GetParentRange(ByRef ParentRange As Range)

Private WsFunc As WorksheetFunction

Private Sub Class_Initialize()
    Set WsFunc = WorksheetFunction
End Sub

Private Sub Class_Terminate()
    'Debug.Print "RangeExPartsClass_Term!"
End Sub

''Itemを指定すると既存のRangeオブジェクトの機能が使用可
Public Property Get Item() As Range
Attribute Item.VB_UserMemId = 0
    Set Item = GetRange()
End Property

''定義したEventを起こしRangeを得る
Private Function GetRange() As Range
    RaiseEvent GetParentRange(GetRange)
End Function

''拡張プロパティ
''指定範囲のSum
Public Property Get Sum() As Variant
    Sum = WsFunc.Sum(GetRange())
End Property

''拡張プロパティ
''指定範囲のAverage
Public Property Get Average() As Variant
    Average = WsFunc.Average(GetRange())
End Property

''拡張プロパティ
''指定範囲のCountIf
Public Property Get CountIf(ByVal BaseRange As Range) As Double
    CountIf = WsFunc.CountIf(GetRange(), BaseRange)
End Property

''拡張プロパティ
''指定範囲の重複の無いリストを返す
Public Property Get UniqueValue(Optional IsTranspose As _
                                Boolean = False) As Variant
    Dim Dic As Object
    Dim r   As Range
    
        Set Dic = CreateObject("Scripting.Dictionary")
        
        For Each r In GetRange()
            If Not IsEmpty(r.Value) Then
                If Not Dic.exists(r.Value) Then
                    Dic.Add r.Value, Empty
                End If
            End If
        Next
        
        If IsTranspose Then
            UniqueValue = WsFunc.Transpose(Dic.keys)
        Else
            UniqueValue = Dic.keys
        End If
        
        Set Dic = Nothing
End Property

''拡張メソッド
''セルに記入した「マクロ名」でマクロを実行する
Public Sub RunCmd(Optional IsAsk As Boolean = False)
    
    Dim r   As Range
    Dim Ret As VbMsgBoxResult
    
    On Error GoTo Err_Handle
        For Each r In GetRange()
            If Not IsEmpty(r.Value) Then
                Ret = 0
                
                If IsAsk Then
                    Ret = MsgBox("マクロ'" & r.Value & _
                                 "'を実行しますか？", vbQuestion Or vbYesNo)
                End If
                
                If (Not IsAsk) Or (Ret = vbYes) Then
                    Application.Run r.Value
                End If
            End If
        Next
    Exit Sub
    
Err_Handle:
    
    MsgBox Err.Description, vbCritical
    Err.Clear
    Resume Next
        
End Sub
''拡張メソッド
''StrConvの実行メソッド
Public Sub StrConvExecute(ByVal Conversion As VbStrConv)
    
    Dim r As Range
            
        For Each r In GetRange()
            r.Value = StrConv(r.Value, Conversion)
        Next
        
End Sub

みなさん、こんばんは。
 
今マコさんの所のツイッター見ました。
特別マコさんに宛てたスレではありませんので、お気になさらずです^^
私が皆様にお聞きしたい事も織り交ぜていますので。
 
# こんな使い方は誰もしていなくてレスを頂けないか、おもいっきり的をはずした発言を
# をしているのでは？と、ちょっと不安です^^;

今だとクラスの「拡張」は，「継承」とは違う概念になっていますね．(^^;)
 
継承とはクラス群のツリー構造（血統みたいな意味を持つ構造）を作るものであり，拡張はクラスを使いやすく・作りやすくするためのものとか．Implements のように「インターフェースを継承」するよう，Ruby の Mix-in のように「実装を継承」したいとか．
 
 
以下、思いついたことをツラツラ書いてみたのですが、結論としては「VBA でクラスの拡張なんてするもんじゃない。ヘルパークラスで十分」かなと思います。
 
みそじのおじさんの方で、「Item.Item を取り除きたい」とありましたが、これはクラスを増やしてしまった弊害かと思います。クラス１つで出来れば出てこない問題ですし。
 
最後の方で「Implements を取り除いた」という話がありますが、Implements は多態性を間違いなく実現するための契約であって、多態性ということは RangeExPartsClass に当たるクラスが複数有るべきとかになってしまいます（イベント規定だと RangeExClass が複数かな）。ということでクラスの拡張とは別の話かなと思います。
 
 
●外部メソッド
拡張を考えると，１つの考え方としては「外部メソッド」があると思います．
 
Public Sub ExtMethod(TargetObject)
 
と，第１引数に拡張したいオブジェクトを指定するプロシージャです．標準モジュールに書きます．
 
使うときは以下です．
    ExtMethod obj
 
外部メソッドなんて名前を付けても，ただの関数・ステートメントです．
＃「外部メソッド」は「リファクタリング」で出てくる言葉ですね．
 
 
C#3.0 だったかは，これを「拡張メソッド」として組み込めるようにしています．C# だと以下のように使えるのです．うらやましい．
    obj.ExtMethod
 
 
ところで，FileSystemObject の File オブジェクトには次のようなメソッドがあります．
<File>.Attributes
<File>.DateLastModified
<File>.Size
 
VBA の古典的なファイルアクセスには以下のような物があります．
GetAttr <FilePath>
FileDateTime <FilePath>
FileLen <FilePath>
 
機能的には変わりません．ステートメントや関数というのは外部メソッドの塊ですね．そして，いちいち対象を書くのが面倒です．
 
書くのが面倒なので，何とかしようというのは糖衣構文やそれに近いものになります．
 
 
●糖衣構文
たとえば Range("A1") と書くのが面倒なとき [A1] で済みますが，これは Range の糖衣構文です．といっても私は正式なコードでこれは使いません．なんか変な感じがしますので．(^^;)
＃変と言うより，本当に Range のみ糖衣構文で，<Worksheet>.Range の代わりにはならないので使う箇所がなく，[] と Range を使い分けるのも統一性に欠けるので使わないのが実情ですね．
 
でもまあ，糖衣構文は便利なものです．
 
Application.WorksheetFunctions が面倒？
 
以下を書けば，
Public Function WF() As WorksheetFunction
    Set WF = Application.WorksheetFunction
End Function
 
下のように使えます．
    Debug.Print WF.Sum([F1:I4])
 
FilsSystemObject だって以下で良い．
Public Function FSO() As Scripting.FileSystemObject
    Set FSO = New Scripting.FileSystemObject
End Function
 
いちいち生成されるコストが馬鹿にならない？　なら以下．
Private m_FSO As Scripting.FileSystemObject
 
Public Function FSO() As Scripting.FileSystemObject
    If m_FSO Is Nothing Then
        Set m_FSO = New Scripting.FileSystemObject
    End If
    Set FSO = m_FSO
End Function
 
って，これは以下と同じだって？
Public FSO As New Scripting.FileSystemObject
 
かなり違う。上のプロシージャには無いけど，独自の初期化が出来るのですよ．
 
独自クラスで，トップレベルのクラスとかは，こんな風にプロジェクトのプロパティとして作ることはよくあります．
 
 
と，ここまで書いたけど，対象 Range を何度も書きたくないというなら保持しないといけないから Facade パターンじゃないけど，ヘルパークラスになるかなぁと思います．
 
 
●Facade パターンもしくはヘルパークラスでしょう，ラッパーは辛いね
Facade は，別システムのたんさんのクラスを扱いたくないから，別システムから使うだろう部分を１つのクラスにまとめて使いやすくするパターン．Facade は玄関とか門構えという意味．
 
前に書いた XlOra も Facade に近い．Oracle のデータベースシステムを扱おうとすると，Session/Database/Dynaset と 3 つのクラスを使わないといけない．簡単に使うだけだから Oracle の玄関的な XlOra クラスを作って集約してしまうし，便利機能も付けちゃう．
 
Facade の場合，本来は Oracle 側に作るべきかなと思うけど，まあいいや．ヘルパークラスとしましょう．
 
 
継承ではなく委譲を受けて，元クラスのすべてのメンバーを公開するのはラッパーと言いますが，一部しか公開しないのはラッパーとは言わないかな？　するとヘルパークラスという，定義がハッキリしていない便利なカテゴリのクラスになります．(^^;)
＃Java ヘルパーだと，ユーザー定義型用のプロシージャが入ったクラスですね．
 
Range のすべてを公開するラッパーも、リフレクションとコードジェネレーターでムリヤリなんとか出来るかもしれないのですが、Range 型しか受け付けないプロシージャや関数にどう対応するのかとか、同一性（Range("A1") と RangeEx("A1") は同一と判断すべき？）とかの問題が出てきます。継承ならだいだい解決できる部分ですが、委譲だとかなり無理です。
 
 
そう考えると Range を拡張するというのは VBA では現実的ではないので，プロジェクトで必要としている機能だけを作り込んだヘルパークラスでいいと判断します．Range の拡張ではなくヘルパーとすれば，拡張っぽく作り込む必要もなくなりクラス１つのシンプルなものにします．
＃クラス２つで親子関係作って、それを Range 拡張のように扱うというのなら、この親子は機能的な親子で、親か子のどちらかは Range 継承クラス（血統的親子）でなければ意味がないでしょう。
 
たとえば Range 関係の実行クラスとして RangeExecutor クラスを作り，あとは，記述を簡単にするためのコンストラクタ関数を作る．これも記述を簡単にしたいので CreateXXXX とはしない．
 
 
○使い方
Public Sub Test()
    ''CountIfプロパティ
    MsgBox Range("A1").Value & "は, " & _
           RExe("A1:D4").CountIf(Range("A1")) & "回出現しています"
End Sub
 
○コンストラクタ関数
Public Function RExe(ByVal TargetRange As Variant) As RangeExecutor
    Set RExe = New RangeExecutor
    RExe.Init TargetRange
End Function
 
○RangeExecutor クラス
ption Explicit
 
Private Type URangeExecutor
    Target As Range
End Type
Private mp As URangeExecutor
 
Public Sub Init(ByVal Target As Variant)
    '' 文字列は Range に変換．※文字列以外は Range が渡されて来るとする．
    If VarType(Target) = vbString Then
        Set Target = Range(Target)
    End If
     
    Set mp.Target = Target
End Sub
 
'' ※Range の Item と同じ形にする．
Public Property Get Item(ByVal RowIndex As Variant, Optional ByVal ColumnIndex As Variant) As Range
    If IsMissing Then
        Set Item = mp.Target.Item(RowIndex)
    Else
        Set Item = mp.Target.Item(RowIndex, ColumnIndex)
    End If
End Property
Public Property Get Range() As Range
    Set Range = mp.Target
End Property
Public Property Get Target() As Range
    Set Range = mp.Target
End Property
 
Public Property Get Sum() As Variant
    Sum = Application.WorksheetFunction.Sum(mp.Target)
End Property
Public Property Get Ave() As Variant
    Ave = Application.WorksheetFunction.Average(mp.Target)
End Property
Public Property Get CountIf(ByVal IfValue As Variant) As Double
    CountIf = Application.WorksheetFunction.CountIf(mp.Target, IfValue)
End Property
・
・
・
 
 
●雑記
○私はプロシージャID は使わない
VBA のクラスでも，プロシージャID の設定が出来て，Default メンバーや NewEnum メンバーを設定できるけど，私はそこまでしない．面倒だし，引き継ぎが難しくなるかなぁと．
 
あと昔と違って、デフォルトプロパティでも省略しないのが今時ですしね。(^^)
 
まあデフォルトはいいとしても For Each には対応したい．すると内部コレクションを Items プロパティで公開することになって，ちょっと抵抗もあるけど，いちいちエクスポート・インポートするよりマシかなと思ってます．
 
○クラス名に Class とは付けない
「クラスの方がプログラムのメイン」という勢いで，接頭子や接尾子をつけるのは標準モジュールやユーザーフォームになります．例：MMain(bas)
 
ユーザーフォームもクラスの一種だけどちょっと違うので接頭子を付けます．例：FDSelectColor
 
ブックやシートはクラスと同じ．でもブックは ThisWorkbook から変えないし，シートは最後に Sheet と付けます．例：MainSheet
 
○mp
MyPropeties の略．私がクラスを書くときの糖衣構文．mp. でメンバーが出てくるのがいいし，以下のように引数名とメンバー名が同じでも問題無いから．
Public Sub Init(ByVal Target As Range)
    Set mp.Target = Target
 
「クラスはユーザー定義型の拡張」から来ている書き方ではなく、「プロパティのシリアライズ」から．プロパティをユーザー定義型にしておくと使い易いと気がついた。(^^)

藤代千尋 さんの引用:
結論としては「VBA でクラスの拡張なんてするもんじゃない。ヘルパークラスで十分」かなと思います。

藤代千尋 さんの引用:
VBA では現実的ではないので，プロジェクトで必要としている機能だけを作り込んだヘルパークラスでいいと判断します．

遅くなりました。
 
▼藤代さん
 
本当に勉強になります。ありがとうございます。
「ヘルパークラスで十分」
この言葉ガツンときました。
 
まず動きを追ってから返信をと思っていたのですが、動きません^^;
自分で修正出来るとやっていましたが、んーお聞きしないと無理でした。
 
Init時に、Set Target = Range(Target)で プロパティGet Rangeに進みますが、
mp.TargetがNothingの為ここでStopしてしまいます。このRange(Target)のRangeは
クラス内のRangeプロパティを指すものでよろしかったでしょうか？
（Rangeオブジェクトを指すのか判別が出来なかった為修正出来ませんでした^^;）
 

Public Sub Init(ByVal Target As Variant) 
    '' 文字列は Range に変換．※文字列以外は Range が渡されて来るとする． 
    If VarType(Target) = vbString Then 
        Set Target = Range(Target) →※１へ
    End If 
     
    Set mp.Target = Target 
End Sub 
 
'' ※Range の Item と同じ形にする． 
Public Property Get Item(ByVal RowIndex As Variant, Optional ByVal ColumnIndex As Variant) As Range 
    If IsMissing Then 
        Set Item = mp.Target.Item(RowIndex) 
    Else 
        Set Item = mp.Target.Item(RowIndex, ColumnIndex) 
    End If 
End Property 
Public Property Get Range() As Range ※１
    Set Range = mp.Target 
End Property 
Public Property Get Target() As Range 
    Set Range = mp.Target ← Set Targetですかね？
End Property 

失礼しました。いろいろミスがあります。(^^;)
 
Init で Range が循環するのは、直前まで RExe の方に入っていた変換を Init に入れた方が良い思って入れたけど、動作確認しなかったためです。この Range は、Application.Range の方です（状況依存 Range）。
 
Public Sub Init(ByVal Target As Variant)
    '' 文字列は Range に変換．※文字列以外は Range が渡されて来るとする．
    If VarType(Target) = vbString Then
        Set Target = Application.Range(Target)
    End If
      
    Set mp.Target = Target
End Sub
 
なのですが「文字列を Range にする」から Application.Range の方と気がついて欲しかったり。(^▽^A)
 
 
Target はご指摘の通りです。
 
Public Property Get Target() As Range
    Set Target = mp.Target
End Property
 
 

引用:
「mp」ってなんの略だろうとずっと

引用:
# 私のコメントアウトの「''」２点打ちは完全に藤代さんの影響です（笑）

前スレの
> 投稿日時: 12/03/07 03:40:39 No.55
yayadonさんのCOMのメソッド扱いにならないケースは知ってましたけど、
PrivateとFriendが隣り合うアドレスに移動してたとは、思いもしませんでした。
 
その下のAbyssさんのコードは、VB6もOffice XP Developerも無いので確認は出来ませんが、
DHTML TimerでTimerProcのスコープを、変更する事で、認識したりしなかったりするので、
http://www.ka-net.org/office/of12.html
こういう事なのかなと思いました。
 
> 投稿日時: 12/03/24 09:12:07 No.77
 
本スレの上のFileSearchの件は別に実用を考えてるわけではなくて、
(Excelのブックが実装してるIDropTarget*をフック)みたいな実験目的です。
 
 
---
http://www.moug.net/faq/viewtopic.php?t=62475
64bitのOLE/COM Object Viewerの件のdllは(IVIEWERS.DLL)
SDKに初めからありますし、ただ初回起動時に権限昇格が必要なだけです。
 
また、シンボリックリンクとジャンクションなど、仮想的なパスに対してはLoadTypeLibExが
エラーを返す旨のメッセージが出ます。

角田 さんの引用:

・どんきち さん提示のものは、
　　「複数のクラス（Ａ,Ｂ,Ｃ…）が持っている共通イベントを纏める」
　　「クラス（オブジェクト、コントロール）配列のイベントを纏める」
　という利用例の違いはありますが、わたしが書いている『擬似からの脱却』と同等の
　考え方（利用側と対象クラスの間に、イベントを纏めるクラスを挟む）ですね。
　
　最近は、大分「クラスを２重に使う」という、この手の方法が浸透しましたが、
　昔はどうだったんでしょうね（ＶＢＡ界では）？　記事でも書いてますが

藤代千尋 さんの引用:

まあデフォルトはいいとしても For Each には対応したい．すると内部コレクションを Items プロパティで公開することになって，ちょっと抵抗もあるけど，いちいちエクスポート・インポートするよりマシかなと思ってます．

Rangeオブジェクトの拡張について
 
自分がRangeオブジェクトの機能を拡張するとなったら、クラスにせずに、標準モジュールにRange型オブジェクトを引数に持つ拡張したい機能を実装したプロシージャを山のように作るような気がします。
 
以下のようなことが気になるので、いきなりクラスにしようとは考えない気がします。
 
・Excel VBA でRangeオブジェクトのインスタンスを生成するメソッドは山のようにある。
　拡張したRangeオブジェクトのインスタンスを、それらのすべてのメソッドと同じように生成できるか。
 
・既存のRange型オブジェクト型変数へそのまま代入できるか。
 
１つのRange型オブジェクト変数に対して複数のプロシージャを実行することが多いのであれば、クラスにして、個々のプロシージャにRange型オブジェクトの引数は持たせず、クラスに対象とするrange型オブジェクトを設定するプロパティを実装するかもしれません。その場合でもクラスは１つで済ませるような気がします。

kumatti さんの引用:
その下のAbyssさんのコードは、VB6もOffice XP Developerも無いので確認は出来ませんが、

#include "stdafx.h"
#include <comdef.h>

//__declspec(dllexport)
void __stdcall QueryTypeInfo(IDispatch *pDisp);
#pragma comment(linker, "/EXPORT:QueryTypeInfo=?QueryTypeInfo@@YGXPAUIDispatch@@@Z")


void __stdcall QueryTypeInfo(IDispatch *pDisp)
{
    UINT ctinfo = 0;
    HRESULT hr = pDisp->GetTypeInfoCount(&ctinfo);  // ctinfo には 1 が返るハズ。
    if (FAILED(hr) || ctinfo == 0) return;


    // http://msdn.microsoft.com/en-us/
    // library/windows/desktop/ms221696%28v=vs.85%29.aspx
    ITypeInfoPtr spTypeInfo;
    hr = pDisp->GetTypeInfo(0, LOCALE_USER_DEFAULT, &spTypeInfo);
    if (FAILED(hr)) return;


    // http://msdn.microsoft.com/en-us/
    // library/windows/desktop/ms221003%28v=vs.85%29.aspx
    TYPEATTR *pTypeAttr = NULL;  // CComTypeAttr
    hr = spTypeInfo->GetTypeAttr(&pTypeAttr);
    if (FAILED(hr)) {
        if (pTypeAttr) {
            spTypeInfo->ReleaseTypeAttr(pTypeAttr);
            pTypeAttr = NULL;
        }
        return;
    }

    // 略  --- TYPEATTR のメンバの値の調査/出力
    //pTypeAttr->guid;         // IID (VBA が適時変更)
    //pTypeAttr->typekind;     // TKIND_DISPATCH  
    //                         // デュアル インターフェースもこの値になるので，
    //                         // TYPEFLAG の TYPEFLAG_FDUAL で判断。
    //pTypeAttr->cFuncs;       // Public なメソッド(プロパティ含む)の数。
    //pTypeAttr->cbSizeVft;    // 仮想テーブルのサイズ (Private & Friend 含む)
    //
    // TYPEFLAG
    // http://msdn.microsoft.com/en-us/
    // library/windows/desktop/ms221509%28v=vs.85%29.aspx
    //pTypeAttr->wTypeFlags;   // 0x01c2 
    //                         // TYPEFLAG_FCANCREATE | TYPEFLAG_FDUAL | 
    //                         // TYPEFLAG_FNONEXTENSIBLE | TYPEFLAG_FOLEAUTOMATION


    // http://msdn.microsoft.com/en-us/
    // library/windows/desktop/ms221425%28v=vs.85%29.aspx
    FUNCDESC *pFuncDesc = NULL;  // CComFuncDesc

    // Public なメソッド(プロパティを含む)を列挙。
    for (WORD i = 0; i < pTypeAttr->cFuncs; ++i) {
	hr = spTypeInfo->GetFuncDesc(i, &pFuncDesc);
	if (FAILED(hr)) break;

        // 略 --- FUNCDESC のメンバの値の調査/出力

        MEMBERID memid = pFuncDesc->memid;
        const UINT cMaxNames = 10;
        BSTR bstrNames[cMaxNames] = {0};
        UINT cNames;
        hr = spTypeInfo->GetNames(memid, &bstrNames[0], cMaxNames, &cNames);
	if (FAILED(hr)) break;

        // 略 --- bstrNames の値の調査/出力
        // 一つのものは，メソッド名のみ。
        // 二つ以上あるものは，二つ目からパラメータ名

        for (UINT i = 0; i < cNames; ++i) {
            ::SysFreeString(bstrNames[i]);
        }
	if (pFuncDesc) {
            spTypeInfo->ReleaseFuncDesc(pFuncDesc);
            pFuncDesc = NULL;
        }
    }

    if (pFuncDesc) spTypeInfo->ReleaseFuncDesc(pFuncDesc);
    if (pTypeAttr) spTypeInfo->ReleaseTypeAttr(pTypeAttr);

    return;
}

'' VBA クラスのインターフェース調査
Private Declare Sub QueryTypeInfo Lib "DLL名.dll" (ByVal pDisp As Object)

Private Sub QueryTypeInfo()
    
    '' カレント ディレクトリを DLL のある場所に移動
    Dim strDllDir As String
    strDllDir = "DLLがあるディレクトリ"
    Call ChDrive(strDllDir)
    Call ChDir(strDllDir)
    
    Dim itf As Class1
    Set itf = New Class1
    Call QueryTypeInfo(itf)
    
End Sub

藤代 さんの引用:

「文字列を Range にする」から Application.Range の方と気がついて欲しかったり。(^▽^A)

> .netもやっておりますが...
.netでも Excel.Rangeは Interfaceとして扱われて、Classとしては
扱われていないですね。従っては、「継承」は出来ないと思うんですが。

# だいぶ発言タイミングが遅れてしまったです。
 
みそじのおじさんの２階層のクラスを用いた継承モデルの実装例は、
イベントを巧妙に使ったもので、非常に面白く感じました。
 
継承について言えば、
標準的な機能を持つクラスに対して、機能を追加した継承クラスを作り、
これを活用していくという、いわば差分的プログラムもあると思います。
ただ、Officeに付属のVBAは、そうしたニーズが乏しいと想定されたため、
継承機能はつけなかったと言うことかも知れません。
 
１ RangeのようなExcel固有のクラスであることもあって、、
   これに機能追加する(open classのような）仕組みを採ることは不要と
   開発者は考えた。
２ VBAの下で、ユーザーが独自に作るクラスの場合は、
   さほど汎用的なものではなく、Officeアプリに関連したものなので、
   継承させるよりも、元々のクラスに直接、追加してしまったほうが
   手取り早いだろうとの判断だろうか。
   皆さんのご意見にありましたように、これで致命的に困ることは
   なく、対応方法があるということでしょうね。
３ 一方で、ユーザーフォームは、多様なニーズが見込めるので、
   イベントを備えて、プロシージャが自由に追加できる仕組みを提供した。
ということなんでしょうか。
 
またRuby話で恐縮です。（藤代さんからもC#の同様機能の紹介がありましたが）
例によって、以下はすべてスキップ可能です。
 
クラスに機能をMix-inすることもできますが、
オブジェクトにModuleを混ぜ込むこともできます。

  object.extend ModuleA

# coding: Windows-31J
module Worksheet
   def [] y,x
      self.Cells.Item(y,x).Value
   end

   def []= y,x,value
      self.Cells.Item(y,x).Value = value
   end
end

module RangeEx
   def sum
       $xl.WorksheetFunction.Sum(self)
   end
end

# --------------
   require 'win32ole'  # COM を Ruby で扱えるようにする拡張ライブラリ

   filename = "D:/MyDocuments/201203/test.xlsm"

   $xl   = WIN32OLE.new('Excel.Application')
   $xl.Visible = true
   $book = $xl.Workbooks.Open(filename)

   sheet = $book.Worksheets.Item("Sheet1")
   sheet.extend Worksheet  #   (*1)

   sheet[1,1] = 10
   sheet[1,2] = 20
   sheet[2,1] = 30
   sheet[2,2] = 40

   puts sheet[2,2]         # => 40.0 が出力される
   
   r = $book.Worksheets(1).Range("A1:B2")
   r.extend RangeEx        #   (*2)

   puts r.sum              # => 100.0 が出力される

どんきち さんの引用:
公開するのであれば、内部コレクションとは別に新たにコレクションのインスタンスを作成して、内部コレクションで管理しているすべての要素を新たに作ったコレクションにAddして、コピーした別インスタンスのコレクションを公開したほうが安全かもしれません。

藤代千尋 さんの引用:
プログラマの努力によって構造を維持するのではなく、言語の機能により構造を維持する

kumatti さんの引用:
64bitのOLE/COM Object Viewerの件のdllは(IVIEWERS.DLL)SDKに初めからありますし、

kumatti さんの引用:
また、シンボリックリンクとジャンクションなど、仮想的なパスに対してはLoadTypeLibExがエラーを返す旨のメッセージが出ます。

kumatti さんの引用:
ただ初回起動時に権限昇格が必要なだけです。

みなさん、おはようございます。
 
（２）もあれよあれよの内に95件まで到達致しました。
ちょっと早いですが、晩方まで見る事が出来ませんので次に進みたいと思います。
 
みなさま引き続き（３）へご参加お願い致します。
ありがとうございました。