Intellisense не работает при создании экземпляра подкласса как коллекции

Question

У меня проблема с intellisense при создании экземпляра подкласса внутри Collection внутри основного класса.Программа работает, как и ожидалось, но все равно раздражает не получить intellisense. Есть ли способ вызвать VBA для запуска intellisense и узнать, над каким объектом он действительно работает?

Я пробовал вместо этого использовать массив, но затем мне нужно каким-то образом реализовать метод .Count.

В моем упрощенном примере три модуля:

Module1.bas

Sub run()
    Dim Samsung As New TV
    Samsung.Name = "TV livingroom"

    Samsung.AddOwner "John", "Smith"
    Samsung.AddOwner "Santa", "Claus"
    Samsung.PreviousOwners(1).LastName = "Johnson"
    Samsung.PreviousOwners(1).                      ' Intellisense not working here

    Debug.Print "The name of the TV is: " & Samsung.Name
    Dim i As Integer
    For i = 1 To Samsung.PreviousOwners.Count
        Debug.Print "Owner " & CStr(i) & " is named " & Samsung.PreviousOwners(i).FullName
    Next i
End Sub

TV.cls

Option Explicit
'
Public Name As String
Public PreviousOwners As Collection

Public Sub AddOwner(fName As String, lName As String)
    Dim newOwner As New OwnerInfo
    newOwner.FirstName = fName
    newOwner.LastName = lName
    If PreviousOwners Is Nothing Then Set PreviousOwners = New Collection
    PreviousOwners.Add newOwner
End Sub

OwnerInfo.cls Параметр Явный

Public pFirstName As String
Public pLastName As String

Public Property Get FirstName() As String
    FirstName = pFirstName
End Property
Public Property Let FirstName(arg As String)
    pFirstName = arg
End Property
Public Property Get LastName() As String
    LastName = pLastName
End Property
Public Property Let LastName(arg As String)
    pLastName = arg
End Property

Public Function FullName() As String
    FullName = FirstName & " " & LastName
End Function

Debug output

The name of the TV is: TV livingroom
Owner 1 is named John Johnson
Owner 2 is named Santa Claus

Answer 1

То, что вам нужно, может быть достигнуто путем создания пользовательской коллекции плюс свойство по умолчанию .

Вот основной скелет. Вы можете настроить эту коллекцию в соответствии со своими потребностями.

TV.cls

Public Name As String
Public Make As String

TVCollection.cls

Private m_Coll As Collection

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

Property Get Item(index) As TV
    Set Item = m_Coll(index)
End Property

Public Function Add(varTV As TV)
    m_Coll.Add Item:=varTV
End Function

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

Тогда вы можете использовать эту коллекцию (с работающим IntelliSense):

Sub FFF()
    Dim col As New TVCollection
    Dim varTV As TV
    Set varTV = New TV
    varTV.Name = "Some TV"
    col.Add varTV
    MsgBox col.Item(1).Name '// "Some TV"
    col.Item(1).Name = "Another TV"
    MsgBox col.Item(1).Name '// "Another TV"
End Sub

Однако вы хотите написать col(1), а не col.Item(1). Для этого вам нужно вручную отредактировать файл .cls, чтобы установить Item свойство по умолчанию. Вот что вам нужно сделать:

1) Щелкните правой кнопкой мыши на модуле TVCollection и нажмите Remove TVCollection. В появившемся диалоговом окне выберите Yes. Выберите место для сохранения.

2) Откройте класс сохранения TVCollection.cls в текстовом редакторе и перейдите к строке Property Get Item(index) As TV.

3) Теперь прямо под ним введите следующий код:

Property Get Item(index) As TV
Attribute Item.VB_UserMemId = 0
    Set Item = m_Coll(index)
End Property

4) Сохраните изменения и импортируйте этот класс обратно в VBE: Файл -> Импорт файла ...

Теперь вы можете написать так, и IntelliSense будет работать нормально:

MsgBox col(1).Name

Здесь Вы можете скачать рабочую книгу с кодом.

Answer 2

Я отвечаю на свой вопрос, так как нашел хороший способ решения проблемы.

Подпрограмма Run ниже описывает, какие функции мне интересны (и у меня получилось + intellisense).Я нахожу трехподобную структуру Samsung.PreviousOwners.Count более эстетически приятной, чем что-то вроде Samsung.CountPreviousOwners.

Кроме того, полиморфизм -подобное поведение способности ссылаться на оба Samsung.PreviousOwners дляинформация о наборе и Samsung.PreviousOwners(2) для конкретного владельца.

Module.bas

Sub run()
    Dim Samsung As New TV
    Samsung.Name = "TV livingroom"

    ' Add with TV-method AddOwner (NOT aesthetically pleasing!)
    Samsung.AddOwner "John", "Smith"
    Samsung.AddOwner "Santa", "Claus"

    ' Add with Constructor-like method in OwnerInfo class (more aesthetically pleasing!)
    Samsung.PreviousOwners.AddOwner "Bill", "Clinton"

    ' Add with Collection-like Add method
    Dim NewOwner As New OwnerInfo
    NewOwner.FirstName = "George"
    NewOwner.LastName = "Bush"
    Samsung.PreviousOwners.Add NewOwner

    ' Replace owner 2 with new owner
    Set NewOwner = New OwnerInfo
    NewOwner.FirstName = "Karl"
    NewOwner.LastName = "Jung"
    Samsung.PreviousOwners(2) = NewOwner

    ' Number of owners
    Debug.Print "Number of previous owners: " & CStr(Samsung.PreviousOwners.Count)

    Debug.Print "The name of the TV is: " & Samsung.Name
    Dim i As Integer
    For i = 1 To Samsung.PreviousOwners.Count
        Debug.Print "Owner " & CStr(i) & " is named " & Samsung.PreviousOwners(i).FullName
    Next i
End Sub

Этот код выводит следующее и интеллектуальные работы

Output

Number of previous owners: 4
The name of the TV is: TV livingroom
Owner 1 is named John Smith
Owner 2 is named Karl Jung
Owner 3 is named Bill Clinton
Owner 4 is named George Bush

По сути, я изменил

In TV.cls:

• Изменена открытая переменная PreviousOwners на частную pPreviousOwners
• Новые PreviousOwners Получить свойство с необязательным аргументом 'index'.Если аргумент не задан (-1), тогда установите PreviousOwners в качестве нового класса OwnersInfo и передайте переменную 'pPreviousOwners' в качестве аргумента GlobalInit -методу
• New PreviousOwners Свойство Set and Let

In OwnersInfo.cls:

• Новая закрытая переменная-член 'pContainer' как коллекция
• New "конструктор "GlobalInit, который принимает коллекцию контейнеров в качестве аргумента
• Новый открытый метод" Add "для отражения метода Collection-Add
• Новый открытый метод" Count "для отражения метода Collection-Count

Вот код:

TV.cls

Option Explicit
'
Public Name As String
Private pPreviousOwners As Collection

' Properties
Public Property Get PreviousOwners(Optional index As Integer = -1) As OwnerInfo
    ' If no index is given, pass the pPreviousOwners as argument to a OwnersInfo.GlobalInit-method
    If index = -1 Then
        Dim GlobalOwnerInfo As New OwnerInfo
        GlobalOwnerInfo.GlobalInit pPreviousOwners
        Set PreviousOwners = GlobalOwnerInfo
    Else
        Set PreviousOwners = pPreviousOwners(index)
    End If
End Property

Public Property Let PreviousOwners(index As Integer, arg As OwnerInfo)
    ' Need to copy pPreviousOwners
    Dim NewColl As New Collection
    Dim i As Integer
    For i = 1 To pPreviousOwners.Count
        If i = index Then NewColl.Add arg Else NewColl.Add pPreviousOwners(i)
    Next i
    Set pPreviousOwners = NewColl
End Property

Public Property Set PreviousOwners(index As Integer, arg As OwnerInfo)
    PreviousOwners(index) = arg  ' Reuse the Let property
End Property

' Class event methods
Private Sub Class_Initialize()
    Set pPreviousOwners = New Collection
End Sub


' Methods
Public Sub AddOwner(fName As String, lName As String)
    Dim NewOwner As New OwnerInfo
    NewOwner.FirstName = fName
    NewOwner.LastName = lName
    If pPreviousOwners Is Nothing Then Set pPreviousOwners = New Collection
    pPreviousOwners.Add NewOwner
End Sub

OwnersInfo.cls

Option Explicit

Public FirstName As String
Public LastName As String

Private pContainer As Collection  ' A reference to the container collection (to get global count)

' Class event methods
Private Sub Class_Initialize()
    Set pContainer = New Collection
End Sub

' Methods
Public Sub GlobalInit(ByRef colContainer As Collection)
    Set pContainer = colContainer
End Sub

Public Function Count() As Integer
    Count = pContainer.Count
End Function

Public Sub Add(NewObject As Object)
    pContainer.Add NewObject
End Sub

Public Sub AddOwner(ByVal fName As String, ByVal lName As String)
    Dim NewOwner As New OwnerInfo
    NewOwner.FirstName = fName
    NewOwner.LastName = lName
    pContainer.Add NewOwner
End Sub

Public Function FullName() As String
    FullName = FirstName & " " & LastName
End Function

Answer 3

Используйте мощность свойств в классе (в данном случае, TV класс). Простая версия:

Property Get ParticularPreviousOwner(index as long) as OwnerInfo
    Set ParticularPreviousOwner = PreviousOwners(index)
End Property

Property Get AllPreviousOwners() as Collection
    Set AllPreviousOwners = PreviousOwners
End Property

Первое свойство напрямую отвечает на ваш вопрос, строго набирая ответ, который VBA теперь может использовать с Intellisense. В противном случае вы просто возвращаете Variant, который Intellisense не имеет никакого представления о том, как интерпретировать.

Теперь с помощью пары свойств вы можете скрыть (сделать Private) членов вашего класса - скрыть работу класса и управлять интерфейсами. Вы почти достигли своего класса OwnerInfo - сделайте pFirstName и pLastName Private:

Private pFirstName As String
Private pLastName As String

Также (лошади для курсов), вы могли бы сделать FullName Property, а не Function в этом случае.

Важно : Я привел пример с голыми костями. Проверка ошибок необходима для того, чтобы убедиться, что возвращаются только разумные результаты независимо от того, что код соответствует index. Как только вы привыкнете к этому, вы можете получить несколько мощных и очень полезных классов, которые вы можете использовать много раз.