是否可以从集合中的子对象访问父属性？ [英] Is it possible to access a parent property from a child that is in a collection?

问题描述

我已经尽可能地研究过，从来没有找到关于VBA的明确答案。

这个较旧的StackOverflow帖子几乎有一切，但不完全相同。 VBA课程 - 如何让课程保持额外class

底线 - 我有一个类CClock，它是CContacts集合的父项，CContacts是CContact的父对象。

有没有办法从CContact获取CClock类的属性。所以在下面的代码中，像 Debug.Print，clsContact.Parent.Parent.Lawyer 这样的东西，

尝试设置父母，因为我以为他们应该是，但几乎立即在设置clsClock =新CClock 下面的错误。当我遵循代码，它会在联系人集合中的类终止事件，我无法弄清楚。 （虽然这可能是为什么出现以下错误）。

91 - 对象变量或变量未设置

各种类和一个快速测试平台如下（全部基于Dick Kusleika的链接中的帖子。）谢谢。

（编辑 - 添加测试例程，whooopsy）

  Sub test（）
 
 Dim i As Long，j As Long 
 Dim clsClocks As CClocks 
 Dim clsClock As CClock 
 Dim clsContact As CContact 
 
 Set clsClocks =新CClocks 
 
对于i = 1至3 
设置clsClock =新建CClock 
 clsClock.Lawyer =律师& i 
对于j = 1至3 
设置clsContact =新建CContact 
 clsContact.ContactName =Business Contact&我&  - & j 
 clsClock.Contacts.Add clsContact 
下一个j 
 clsClocks.Add clsClock 
下一个i 
 
对于i = 1到2 
设置clsContact = New CContact 
 clsContact.ContactName =Business Contact 66&  - & i 
 clsClocks（2）.Contacts.Add clsContact 
 Next i 
 
'再次写入数据
对于每个clsClock在clsClocks 
 Debug.Print clsClock.Lawyer 
对于每个clsContact在clsClock.Contacts 
 Debug.Print，clsContact.ContactName 
 Debug.Print，clsContact.Parent.Parent.Lawyer 
 
下一页clsContact 
下一个clsClock 
 
 
 End Sub 
  

Clas CClocks

 'CClocks 
选项显式
私有mcolClocks作为集合
 Private Sub Class_Initialize（）
 Set mcolClocks = New Collection 
 End Sub 
 Private Sub Class_Terminate（）
 Set mcolClocks = Nothing 
 End Sub 
 Public属性Get NewEnum（）As IUnknown 
 Set NewEnum = mcolClocks。[_ NewEnum] 
 End Property 
 Public Sub Add（clsClock As CClock）
如果clsClock.ClockID = 0然后
 clsClock.ClockID = Me.Count + 1 
 End If 
 
 Set clsClock.Parent = Me 
 mcolClocks.Add clsClock，CStr（clsClock.ClockID）
 End Sub 
公共属性获取时钟（vItem As Variant）作为CClock 
设置时钟= mcolClocks.Item（vItem）
结束属性
公共属性获取Count（）As Long 
 Count = mcolClocks .Count 
结束属性
公共子删除（vItem As Variant）
 clsClock.Remove vItem 
 End Sub 
 Public Sub Clear（）
 Set clsClock =新集合
 End Sub 
  

CClock类

 'CClock 
私人mlClockID As Long 
私人msLawyer As String 
私人mlParentPtr As Long 
私有mclsContacts作为CContacts 
私有声明Sub CopyMemory Libkernel32别名RtlMoveMemory_ 
（dest As Any，Source As Any，ByVal bytes As Long）
公共属性集联系人（ByVal clsContacts作为CContacts）：设置mclsContacts = clsContacts：End Pr操作
公共属性获取联系人（）作为CContacts：设置联系人= mclsContacts：结束属性
公共属性让ClockID（ByVal lClockID As Long）：mlClockID = lClockID：End Property 
公共属性获取ClockID （）As Long：ClockID = mlClockID：End Property 
公共属性让律师（ByVal sLawyer As String）：msLawyer = sLawyer：End Property 
公共属性获取律师（）As String：Lawyer = msLawyer：End属性
公共属性Get Parent（）As CClocks：Set Parent = ObjFromPtr（mlParentPtr）：End Property 
公共属性集父（obj为CClocks）：mlParentPtr = ObjPtr（obj）：End Property 
私有函数ObjFromPtr（ByVal pObj As Long）As Object 
 Dim obj As Object 
 CopyMemory obj，pObj，4 
 Set ObjFromPtr = obj 
'手动销毁临时对象变量
'（如果你省略这个步骤，你会得到一个GPF！）
 CopyMemory obj，0& 4 
结束函数
 Private Sub Class_Initialize（）
设置mcls Contacts = New CContacts 
 Set Me.Contacts.Parent = Me 
 End Sub 
 Private Sub Class_Terminate（）
 Set mclsContacts = Nothing 
 End Sub 
' CContacts 
选项显式
私有mcolContacts作为集合
私人mlParentPtr As Long 
私有声明Sub CopyMemory Libkernel32别名RtlMoveMemory_ 
（dest As Any，Source As Any，ByVal bytes As Long）
公共属性Get Parent（）As CClock：Set Parent = ObjFromPtr（mlParentPtr）：End Property 
 Private Sub Class_Initialize（）
设置mcolContacts =新集合
 End Sub 
 Private Sub Class_Terminate（）
 Set mcolContacts = Nothing 
 End Sub 
公共属性Get NewEnum（）As IUnknown 
 Set NewEnum = mcolContacts。[ _NewEnum] 
 End Property 
 Public Sub Add（clsContact As CContact）
如果clsContact.ContactID = 0然后
 clsContact.ContactID = Me.Count + 1 
 End If 
设置clsContact.Parent = Me 
 mcolContacts.Ad d clsContact，CStr（clsContact.ContactID）
 End Sub 
公共属性获取时钟（vItem As Variant）作为CContact 
设置时钟= mcolContacts.Item（vItem）
结束属性
公共属性获取Count（）As Long 
计数= mcolContacts.Count 
结束属性
公共子删除（vItem As Variant）
 clsContact.Remove vItem 
 End Sub 
 Public Sub Clear（）
 Set clsContact = New Colletion 
 End Sub 
私有函数ObjFromPtr（ByVal pObj As Long）As Object 
 Dim obj As Object 
 CopyMemory obj，pObj，4 
设置ObjFromPtr = obj 
'手动销毁临时对象变量
'（如果省略此步骤，您将获得GPF！）
 CopyMemory obj，0& 4 
结束函数
  

类CContact

 'CContact 
私人mlContactID As Long 
私人msContactName As String 
私人mlParentPtr As Long 
私人声明Su b CopyMemory Libkernel32别名RtlMoveMemory_ 
（dest As Any，Source As Any，ByVal bytes As Long）
 
公共属性让ContactID（ByVal lContactID As Long）：mlContactID = lContactID：End Property 
公共属性Get ContactID（）As Long：ContactID = mlContactID：End Property 
公共属性让ContactName（ByVal sContactName As String）：msContactName = sContactName：End Property 
公共属性获取ContactName（）As String：ContactName = msContactName：End Property 
公共属性Get Parent（）作为CContacts：Set Parent = ObjFromPtr（mlParentPtr）：End Property 
公共属性集父（obj作为CContacts）： mlParentPtr = ObjPtr（obj）：End Property 
私有函数ObjFromPtr（ByVal pObj As Long）As Object 
 Dim obj As Object 
 CopyMemory obj，pObj，4 
 Set ObjFromPtr = obj 
'手动销毁临时对象变量
'（如果省略此步骤，您将获得GPF！）
 CopyMemory obj，0& 4 
结束函数
  

解决方案

访问内核内存来做到这一点，让我知道。看一下 vbWatchDog 的源代码的一些提示。我一直在研究它来尝试访问调用堆栈。我还没有想出来。

我会告诉你如何假冒它。我要简化一下。您需要将原则应用于您自己的代码。这个伎俩很丑陋。它需要我们每次创建一个新的子对象时调用 Initialize 例程$ /
$ b

父类：

 '类父
选项显式
 
私有mName为String 
公共属性获取名称（）作为字符串
名称= mName（）
结束属性
 
公共属性Let Name（value As String）
 mName =值
结束属性
  

子类

 'Class Child 
 Option Explicit 
 
私人mParent为父
 
公开属性Get Parent（）作为父
设置Parent = mParent 
结束属性
 
公共属性让名称（Obj为父）
设置mParent = Obj 
结束属性
 
 Public Sub初始化（Obj作为父项）
设置Me.Parent = Obj 
 End Sub 
  

创建子对象

 子CreateChi ld（）
 Dim parentObject As New Parent 
'创建具有父属性的子对象
 Dim childObject作为新子元素
 childObject.Initialize（parentObject）
 End Sub 
  

I've researched as much as I can and never found a definitive answer on this for VBA.

This older StackOverflow post has almost everything, but not quite. VBA Classes - How to have a class hold additional classes

Bottom line - I have a class CClock, which is parent to a Collection of CContacts, which is parent to a CContact.

Is there any way to get at a property of the CClock class from a CContact. So something like Debug.Print , clsContact.Parent.Parent.Lawyer in the code below?

I've tried setting the parents as I thought they should be but get the below error almost immediately at Set clsClock = New CClock. When I follow the code it goes to class terminate event in the Contacts collection, which I can't figure out. (Although that is probably why the error below comes up.)

91 - Object Variable or With Variable not set

The various classes and a quick test rig are below (all based on Dick Kusleika's post in the link.) Thanks.

(Edit- added the test routine, whooopsy)

Sub test()

    Dim i As Long, j As Long
    Dim clsClocks As CClocks
    Dim clsClock As CClock
    Dim clsContact As CContact

    Set clsClocks = New CClocks

    For i = 1 To 3
        Set clsClock = New CClock
        clsClock.Lawyer = "lawyer " & i
        For j = 1 To 3
            Set clsContact = New CContact
            clsContact.ContactName = "Business Contact " & i & "-" & j
            clsClock.Contacts.Add clsContact
        Next j
        clsClocks.Add clsClock
    Next i

    For i = 1 To 2
        Set clsContact = New CContact
        clsContact.ContactName = "Business Contact 66" & "-" & i
        clsClocks(2).Contacts.Add clsContact
    Next i

    'write the data backout again
    For Each clsClock In clsClocks
        Debug.Print clsClock.Lawyer
        For Each clsContact In clsClock.Contacts
            Debug.Print , clsContact.ContactName
            Debug.Print , clsContact.Parent.Parent.Lawyer

        Next clsContact
    Next clsClock


End Sub

Clas CClocks

'CClocks
Option Explicit
Private mcolClocks As Collection
Private Sub Class_Initialize()
    Set mcolClocks = New Collection
End Sub
Private Sub Class_Terminate()
    Set mcolClocks = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
    Set NewEnum = mcolClocks.[_NewEnum]
End Property
Public Sub Add(clsClock As CClock)
    If clsClock.ClockID = 0 Then
        clsClock.ClockID = Me.Count + 1
    End If

    Set clsClock.Parent = Me
    mcolClocks.Add clsClock, CStr(clsClock.ClockID)
End Sub
Public Property Get Clock(vItem As Variant) As CClock
    Set Clock = mcolClocks.Item(vItem)
End Property
Public Property Get Count() As Long
    Count = mcolClocks.Count
End Property
Public Sub Remove(vItem As Variant)
        clsClock.Remove vItem
End Sub
Public Sub Clear()
        Set clsClock = New Collection
End Sub

Class CClock

'CClock
Private mlClockID As Long
Private msLawyer As String
Private mlParentPtr As Long
Private mclsContacts As CContacts
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (dest As Any, Source As Any, ByVal bytes As Long)
Public Property Set Contacts(ByVal clsContacts As CContacts): Set mclsContacts = clsContacts: End Property
Public Property Get Contacts() As CContacts: Set Contacts = mclsContacts: End Property
Public Property Let ClockID(ByVal lClockID As Long): mlClockID = lClockID: End Property
Public Property Get ClockID() As Long: ClockID = mlClockID: End Property
Public Property Let Lawyer(ByVal sLawyer As String): msLawyer = sLawyer: End Property
Public Property Get Lawyer() As String: Lawyer = msLawyer: End Property
Public Property Get Parent() As CClocks: Set Parent = ObjFromPtr(mlParentPtr): End Property
Public Property Set Parent(obj As CClocks): mlParentPtr = ObjPtr(obj): End Property
Private Function ObjFromPtr(ByVal pObj As Long) As Object
    Dim obj As Object
    CopyMemory obj, pObj, 4
    Set ObjFromPtr = obj
    ' manually destroy the temporary object variable
    ' (if you omit this step you'll get a GPF!)
    CopyMemory obj, 0&, 4
End Function
Private Sub Class_Initialize()
    Set mclsContacts = New CContacts
    Set Me.Contacts.Parent = Me
End Sub
Private Sub Class_Terminate()
    Set mclsContacts = Nothing
End Sub
'CContacts
Option Explicit
Private mcolContacts As Collection
Private mlParentPtr As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (dest As Any, Source As Any, ByVal bytes As Long)
Public Property Get Parent() As CClock: Set Parent = ObjFromPtr(mlParentPtr): End Property
Private Sub Class_Initialize()
    Set mcolContacts = New Collection
End Sub
Private Sub Class_Terminate()
    Set mcolContacts = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
    Set NewEnum = mcolContacts.[_NewEnum]
End Property
Public Sub Add(clsContact As CContact)
    If clsContact.ContactID = 0 Then
        clsContact.ContactID = Me.Count + 1
    End If
    Set clsContact.Parent = Me
    mcolContacts.Add clsContact, CStr(clsContact.ContactID)
End Sub
Public Property Get Clock(vItem As Variant) As CContact
    Set Clock = mcolContacts.Item(vItem)
End Property
Public Property Get Count() As Long
    Count = mcolContacts.Count
End Property
Public Sub Remove(vItem As Variant)
        clsContact.Remove vItem
End Sub
Public Sub Clear()
        Set clsContact = New Colletion
End Sub
Private Function ObjFromPtr(ByVal pObj As Long) As Object
    Dim obj As Object
    CopyMemory obj, pObj, 4
    Set ObjFromPtr = obj
    ' manually destroy the temporary object variable
    ' (if you omit this step you'll get a GPF!)
    CopyMemory obj, 0&, 4
End Function

Class CContact

'CContact
Private mlContactID As Long
Private msContactName As String
Private mlParentPtr As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (dest As Any, Source As Any, ByVal bytes As Long)

Public Property Let ContactID(ByVal lContactID As Long): mlContactID = lContactID: End Property
Public Property Get ContactID() As Long: ContactID = mlContactID: End Property
Public Property Let ContactName(ByVal sContactName As String): msContactName = sContactName: End Property
Public Property Get ContactName() As String: ContactName = msContactName: End Property
Public Property Get Parent() As CContacts: Set Parent = ObjFromPtr(mlParentPtr): End Property
Public Property Set Parent(obj As CContacts): mlParentPtr = ObjPtr(obj): End Property
Private Function ObjFromPtr(ByVal pObj As Long) As Object
    Dim obj As Object
    CopyMemory obj, pObj, 4
    Set ObjFromPtr = obj
    ' manually destroy the temporary object variable
    ' (if you omit this step you'll get a GPF!)
    CopyMemory obj, 0&, 4
End Function

解决方案

If you figure out how to access the kernel memory to do this, let me know. Take a look at the source code of vbWatchDog for some hints. I have been studying it to try to gain access to the call stack. I haven't figured it out yet.

I'll show you how to fake it though. I'm going to simplify this a bit. You'll need to apply the principle to your own code. The trick is kind of ugly. It requires that we call an Initialize routine each time we create a new child object

The Parent Class:

'Class Parent
Option Explicit

Private mName as String
Public Property Get Name() as String
    Name = mName()
End Property

Public Property Let Name(value As String)
    mName = value
End Property

The Child class

'Class Child
Option Explicit

Private mParent as Parent    

Public Property Get Parent() as Parent
    Set Parent = mParent
End Property

Public Property Let Name(Obj as Parent)
    Set mParent = Obj
End Property

Public Sub Initialize(Obj as Parent)
    Set Me.Parent = Obj
End Sub

Creating a Child object:

Sub CreateChild()
    Dim parentObject As New Parent
    ' create child object with parent property
    Dim childObject As New Child
    childObject.Initialize(parentObject)
End Sub

这篇关于是否可以从集合中的子对象访问父属性？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！