VBA类 - 如何让类保存其他类

Question

我有一个挑战,我试图用类来解决.

我正在将事务记录到类中.

每笔交易都有以下内容:

• 名称
• 日期
• 时间
• 描述

但是,每个事务还可以与许多业务相关的联系人具有以下属性

• 业务联系人姓名
• 商业领域
• 比尔的百分比

有没有关于如何做到这一点的例子.

我尝试为业务联系人添加第二个类,然后在事务类中构建一个集合,所有这些都没有任何乐趣.

我也尝试将业务联系人详细信息作为交易类中的一个集合,也没有任何乐趣.

下面是我到目前为止,但我可能已经走下了一条死胡同,可能不值得尝试拯救代码

任何帮助非常感谢.

谢谢JP

---

测试子 - 尝试写入数据并将其取回

Sub test()

    Dim x As Integer
    Dim xx As Integer

    'code to populate some objects
    Dim clocklist As Collection
    Dim clock As classClocks
    Dim businesscontactlist As Collection
    Dim businesscontact As classBusinessContact

    Set businesscontactlist = New Collection
    Set clocklist = New Collection

    For x = 1 To 3
        Set clock = New classClocks
        clock.LawyerName = "lawyer " & Str(x)
        For xx = 1 To 3
            businesscontact.Name = "Business Contact " & Str(xx)
            businesscontactlist.Add businesscontact

        Next xx
        clock.BusinessContactAdd businesscontactlist '----- errors here
        clocklist.Add clock
    Next x

    Set businesscontactlist = Nothing

    'write the data backout again
    For Each clock In clocklist
        Debug.Print clock.LawyerName
        Set businesscontactlist = clock.BusinessContacts
        For Each businesscontact In businesscontactlist
            Debug.Print businesscontact.Name
        Next

    Next

End Sub

---

时钟类 - 这是事务类

Private pLawyerName As String
Private pBusinessContactList As Collection

Public Property Get LawyerName() As String
    LawyerName = pLawyerName
End Property

Public Property Let LawyerName(ByVal sLawyerName As String)
    pLawyerName = sLawyerName
End Property

Public Property Get BusinessContacts() As Collection
    Set BusinessContacts = pBusinessContactList
End Property

Public Property Set BusinessContactAdd(ByRef strName() As Collection)
    Set pBusinessContactList = New Collection
    Dim businesscontact As classBusinessContact
    Set businesscontact = New classBusinessContact

    For Each businesscontact In strName
        businesscontact.Name = strName.Item()
        pBusinessContactList.Add businesscontact
    Next
End Property

---

业务联系类 - 目前它只有一个属性

Private pBusinessContactName As String

Public Property Get Name() As String
    Name = pBusinessContactName
End Property

Public Property Let Name(ByVal sName As String)
    pBusinessContactName = sName
End Property

Answer 1

有些事情在您的代码中没有达到预期效果.我已经清理了一下,这个新版本应该更接近你想要的.如果变化不是不言自明的,请告诉我.

主要程序:

Sub test()

    Dim i As Long
    Dim j As Long

    'code to populate some objects
    Dim clocklist As Collection
    Dim clock As classClocks
    Dim businessContactList As Collection
    Dim businessContact As classBusinessContact

    Set clocklist = New Collection

    For i = 1 To 3
        Set businessContactList = New Collection
        Set clock = New classClocks
        clock.LawyerName = "lawyer " & i
        For j = 1 To 3
            Set businessContact = New classBusinessContact
            businessContact.Name = "Business Contact " & j
            businessContactList.Add businessContact
        Next j
        Set clock.BusinessContactAdd = businessContactList
        clocklist.Add clock
    Next i

    Set businessContactList = Nothing

    'write the data backout again
    For Each clock In clocklist
        Debug.Print clock.LawyerName
        Set businessContactList = clock.BusinessContacts
        For Each businessContact In businessContactList
            Debug.Print businessContact.Name
        Next

    Next

End Sub

classClocks:

Private pLawyerName As String
Private pBusinessContactList As Collection

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

Public Property Get LawyerName() As String
    LawyerName = pLawyerName
End Property

Public Property Let LawyerName(ByVal sLawyerName As String)
    pLawyerName = sLawyerName
End Property

Public Property Get BusinessContacts() As Collection
    Set BusinessContacts = pBusinessContactList
End Property

Public Property Set BusinessContactAdd(contactCollection As Collection)

    For Each contactName In contactCollection
        pBusinessContactList.Add contactName
    Next

End Property

Answer 2

我倾向于将所有内容都设为一个类并将类调用链接在一起以访问它们。这并不比 assylias 发布的方法更好，只是不同。你可能更喜欢它。

CClocks（作为 Clock 实例的父级的集合类）

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

时钟类

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
End Sub

Private Sub Class_Terminate()
    Set mclsContacts = Nothing
End Sub

CContacts（CContact 的父类和每个 Clock 类的子类）

Private mcolContacts As Collection

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 Contact(vItem As Variant) As CContact
    Set Contact = mcolContacts.Item(vItem)
End Property

Public Property Get Count() As Long
    Count = mcolContacts.Count
End Property

联系方式

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

和测试程序

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

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

End Sub

我没有将 Contacts 作为 CClock 的一个组成部分，而是将其作为自己的类/集合类。然后我可以访问像

clsClock.Contacts.Item(1).ContactName

如果出现，我可以在代码中的其他地方使用 CContacts。

您可以忽略 NewEnum 和 CopyMemory 的内容或在此处阅读有关内容http://www.dailydoseofexcel.com/archives/2010/07/04/custom-collection-class/和此处http://www.dailydoseofexcel.com/archives /2007/12/28/terminating-dependent-classes/#comment-29661 这两个部分是这样我可以有一个 Parent 属性而不必担心垃圾收集（CopyMemory 和 ObjPtr），所以我可以 For.Each 通过类（NewEnum ）。