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

时间：2012-03-13 14:34:06

标签： vba class

我正在尝试使用类来解决这个问题。

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

每笔交易都有以下内容：

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

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

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

是否有任何关于如何做到这一点的例子。

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

我也尝试在交易类中将业务联系人详细信息设置为一个集合，但也没有任何乐趣。

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

任何帮助都非常感激。

由于 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

3 个答案:

答案 0 :(得分：7)

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

主要程序：

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

答案 1 :(得分：4)

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

CClocks（CClock实例的父级的集合类）

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课程

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的父类和每个CClock类的子类）

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）。

答案 2 :(得分：3)

我暂时没有做过VBA，但我注意到这一行：

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

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

相关问题
最新问题