VBA 类 - 如何让一个类拥有额外的类

VBA Classes - How to have a class hold additional classes

提问by JPC

I have a challenge that I am trying to solve using classes.

我正在尝试使用类来解决一个挑战。

I am logging transactions into a class.

我正在将事务记录到一个类中。

Each transaction has the following:

每笔交易都有以下内容：

• Name
• Date
• Time
• Description

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

However each transaction can also have many business related contacts with the following properties

但是，每笔交易也可以有许多具有以下属性的业务相关联系人

• Business Contact Name
• Business Area
• Percentage of Bill

• 业务联系人姓名
• 商业领域
• 账单百分比

Are there any examples of how this would be done.

是否有任何示例说明如何做到这一点。

I have tried adding a second class for the business contact and then building a collection inside the transaction class, all with no joy.

我曾尝试为业务联系人添加第二个类，然后在事务类中构建一个集合，但都没有任何乐趣。

I have also tried making the business contact details a collection within the transaction class also with no joy.

我还尝试将业务联系方式作为交易类中的一个集合，但也没有任何乐趣。

Below is what I have so far, but i may have gone down a blind alley and it may not be worth trying to rescue the code

以下是我到目前为止所拥有的，但我可能已经走上了死胡同，可能不值得尝试拯救代码

Any help much appreciated.

非常感谢任何帮助。

Thanks JP

谢谢太平绅士

---

---

Test sub - trying to write the data in and get it back out

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

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

---

---

Clock Class - this is the transaction class

时钟类 - 这是事务类

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

---

---

Business contact Class - For the moment it only has one 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

采纳答案by assylias

There are a few things that don't do what you expect in your code. I have cleaned it a bit and this new version should be closer to what you want. Let me know if the changes are not self-explanatory.

有一些事情不会按照您在代码中的预期进行。我已经清理了一下，这个新版本应该更接近你想要的。如果这些更改不言自明，请告诉我。

Main procedure:

主要程序：

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

回答by Dick Kusleika

I tend to make everything a class and chain the class calls together to access them. It's not a better way than the one that assylias posted, just different. And you may prefer it.

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

CClocks (collection class that's the parent of the CClock instances)

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

CClock class

时钟类

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 (parent class to CContact and a child to each CClock class)

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

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

And the test procedure

和测试程序

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

Instead of having Contacts as an integral part of CClock, I make it its own class/collection class. Then I can access like

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

clsClock.Contacts.Item(1).ContactName

And I can use CContacts somewhere else in my code if it comes up.

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

You can ignore the NewEnum and CopyMemory stuff or read about it here http://www.dailydoseofexcel.com/archives/2010/07/04/custom-collection-class/and here http://www.dailydoseofexcel.com/archives/2007/12/28/terminating-dependent-classes/#comment-29661Those two parts are so I can have a Parent property without worrying about garbage collection (CopyMemory and ObjPtr) and so I can For.Each through the class (NewEnum).

您可以忽略 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 ）。

回答by Ann L.

I haven't done VBA for a while, but I noticed this line:

我有一段时间没有做 VBA，但我注意到这一行：

Public Property Set BusinessContactAdd(ByRef strName() As Collection) 

I thinkputting parentheses on a parameter name indicates that it's an array, which yours is not: it's a single instance of a collection.

我认为在参数名称上加上括号表示它是一个数组，而你的不是：它是一个集合的单个实例。