尝试使用示例设置自定义对象模型,而不是工作

时间:2013-09-17 18:50:51

标签: excel vba

我正在尝试使用我在stackoverflow上的回答问题中找到的示例来设置自定义对象模型。

VBA Classes - How to have a class hold additional classes

以下是我根据答案创建的代码。

标准模块

Sub test()

Dim i As Long
Dim j As Long

'code to populate some objects
Dim AssemList As Collection
Dim Assem As cAssem
Dim SubAssemList As Collection
Dim SubAssem As cSubAssem

Set AssemList = New Collection

For i = 1 To 3
    Set SubAssemList = New Collection
    Set Assem = New cAssem
    Assem.Description = "Assem " & i
    For j = 1 To 3
        Set SubAssem = New cSubAssem
        SubAssem.Name = "SubAssem" & j
        SubAssemList.Add SubAssem
    Next j
    Set Assem.SubAssemAdd = SubAssemList '<------ Object variable or With Block not Set
    AssemList.Add Assem
    Next i

Set SubAssemList = Nothing

'write the data backout again
For Each clock In AssemList
    Debug.Print Assem.Description
    Set SubAssemList = Assem.SubAssems
    For Each SubAssem In SubAssemList
        Debug.Print SubAssem.Name
    Next

Next

End Sub

cAssem Class

Private pDescription As String
Private pSubAssemList As Collection

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

Public Property Get Description() As String
    Description = pDescription
End Property

Public Property Let Description(ByVal sDescription As String)
    pDescription = sDescription
End Property

Public Property Get SubAssems() As Collection
    Set SubAssems = pSubAssemList
End Property

Public Property Set SubAssemAdd(AssemCollection As Collection)

    For Each AssemName In AssemCollection
        pSubAssemList.Add AssemName ' <------- This is the line that is triggering the error
    Next

End Property

cSubAssem Class

Private pSubAssemName As String

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

除了类名和变量名之外,我没有更改代码中的任何内容,从我有限的观点来看,我无法理解错误的原因。

我刚刚开始真正深入研究VBA中的对象和类模块,所以我感谢这个社区可以通过的任何知识。

非常感谢

1 个答案:

答案 0 :(得分:3)

您的子类初始值设定项中有拼写错误:

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

应为:

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