Создание пользовательской коллекции в Excel VBA

Question

Я работаю над созданием класса коллекции клиентов, который содержит функции, если он содержит объект или если вы хотите удалить определенный объект. Но мне интересно, есть ли способ вызвать объект в определенном месте.

Вот пример:

Если я захочу второй объект в обычной коллекции, я бысделайте это coll(2), и я получу второй объект.

Как я могу использовать аналогичную номенклатуру для пользовательского класса? Вот мой пользовательский класс.

Option Explicit

Private Const modName = "CollectionClass"

Private zCollection As New Collection

Property Get coll() As Collection
    Set coll = zCollection
End Property

Public Function Count() As Variant

10      On Error GoTo SUB_ERR

20      Count = zCollection.Count

SUB_EXIT:
30      Exit Function

SUB_ERR:
40      ProcessError errorNumber:=Err.Number, _
                     errorDescription:=Err.Description, _
                     errorLine:=Erl, _
                     errorInRoutine:=modName & ": Count"

End Function

Public Sub Add(var As Variant)

10      On Error GoTo SUB_ERR

20      zCollection.Add var

SUB_EXIT:
30      Exit Sub

SUB_ERR:
40      ProcessError errorNumber:=Err.Number, _
                     errorDescription:=Err.Description, _
                     errorLine:=Erl, _
                     errorInRoutine:=modName & ": Add"

End Sub

Public Sub Remove(loc As Long)

10      On Error GoTo SUB_ERR

20      zCollection.Remove loc

SUB_EXIT:
30      Exit Sub

SUB_ERR:
40      ProcessError errorNumber:=Err.Number, _
                     errorDescription:=Err.Description, _
                     errorLine:=Erl, _
                     errorInRoutine:=modName & ": Remove"

End Sub

Public Sub RemoveObj(var As Variant)

10      On Error GoTo SUB_ERR

20      Dim i As Long

30      If IsMissing(var) Then
40          Dim xxx As Integer: xxx = 1000000 'Errors if no var sent
50      Else
60          Select Case TypeName(var)
                Case "PartClass"
70                  Dim part As PartClass
80                  i = 1
90                  For Each part In zCollection
100                     If part Is var Then
110                         Me.Remove i
120                         Exit Sub
130                     End If
140                     i = i + 1
150                 Next
160             Case Else
170                 xxx = 1000000 'Errors if unknown Type Name
180         End Select
190     End If

SUB_EXIT:
200     Exit Sub

SUB_ERR:
210     ProcessError errorNumber:=Err.Number, _
                     errorDescription:=Err.Description, _
                     errorLine:=Erl, _
                     errorInRoutine:=modName & ": RemoveObj"

End Sub

Public Function Contains(var As Variant) As Boolean

10      On Error GoTo FUNC_ERR

30      If IsMissing(var) Then
40          Dim xxx As Integer: xxx = 1000000 'Errors if no var sent
50      Else
60          Select Case TypeName(var)
                Case "PartClass"
70                  Dim part As PartClass
90                  For Each part In zCollection
100                     If part Is var Then
110                         Contains = True
120                         Exit Function
130                     End If
150                 Next
160             Case Else
170                 xxx = 1000000 'Errors if unknown Type Name
180         End Select
190     End If

FUNC_EXIT:
200     Exit Function

FUNC_ERR:
210     ProcessError errorNumber:=Err.Number, _
                     errorDescription:=Err.Description, _
                     errorLine:=Erl, _
                     errorInRoutine:=modName & ": Contains"

End Function

Так что, если у меня есть экземпляр моей пользовательской коллекции custColl, в настоящее время я должен использовать это, чтобы получить второй объект custColl.Coll(2), но мне интересноесли есть способ сделать так, я могу просто сделать custColl(2)

Спасибо за помощь! Jason

Answer 1

На самом деле, я думал о свойствах по умолчанию впоследствии (так же, как указано Хел), и на самом деле возможно возможно, и я проверил это.

Вам просто нужно написатьфункция, которая принимает целочисленный аргумент для возврата желаемого значения из коллекции;и установите его в качестве члена по умолчанию, добавив строку Attribute Value.VB_UserMemId = 0 в текстовом редакторе после экспорта модуля класса. (После того, как вы импортируете его снова, строка не будет видна, но она все равно вступит в силу.)

Мой супер простой пример класса "Test":

Private arr(1 To 3) As String

Private Sub Class_Initialize()
    arr(1) = "One"
    arr(2) = "Two"
    arr(3) = "Three"
End Sub

Public Function value(i As Integer) As String
    Attribute Value.VB_UserMemId = 0
    value = arr(i)
End Function

Затем его можно использоватьследующим образом:

Sub Testing()
    Dim a As Test
    Set a = New Test
    Debug.Print a.value(2)
    Debug.Print a(3)
End Sub

И он вернет «Два» для a.value (2) в соответствии с текущим подходом и «Три» для a (3) по желанию.

Для болееинформация о настройке члена класса по умолчанию, см. сайт Чипа Пирсона: http://www.cpearson.com/excel/DefaultMember.aspx

Введение

Если вы работаете с классами в VBA (см. Модули классовдля более подробной информации) часто полезно сделать одного члена класса членом по умолчанию. Например, в объекте диапазона Excel элементом по умолчанию является значение. Это позволяет опустить имя члена и использовать код, подобный следующему:

Range("A1") = 1234 ' is the same as
Range("A1").Value = 1234

Поскольку значение является элементом по умолчанию, оно может быть опущено в коде. Создание члена класса по умолчанию также очень полезно (действительно необходимо), когда вы работаете с настроенным классом Collection. (См. Создание пользовательского класса коллекции для получения дополнительной информации о пользовательских классах коллекции.) В этом случае вы, вероятно, указали бы метод Item в качестве элемента по умолчанию. Это позволяет использовать код, подобный следующему:

V = Coll(2)
' is the same as
V = Coll.Item(2)

Создание элемента по умолчанию в VBA

VBA напрямую не поддерживает создание элемента по умолчаниюкласс. То есть в IDE VBA нет ничего, что позволяло бы указывать члена по умолчанию. Тем не менее, VBA уважает метод по умолчанию, если он указан в классе. Чтобы указать метод в качестве члена по умолчанию, необходимо экспортировать модуль класса в текстовый файл, отредактировать этот текстовый файл в NotePad или в своем любимом текстовом редакторе, добавить директиву атрибута в метод, а затем импортировать текстовый файл обратно вПроект VBA.

Сначала экспортируйте модуль класса в текстовый файл. В VBA перейдите в меню «Файл» и выберите «Экспорт файла ...». В появившемся диалоговом окне «Сохранить» перейдите к какой-либо папке (неважно, какая папка) и сохраните файл класса в виде текста с расширением cls. Далее выберите «Удалить ...» в меню «Файл» и выберите «Нет» в «Вы хотите экспортировать? Диалог. Затем откройте Блокнот (C: \ Windows \ Notepad.exe) или другой текстовый редактор и откройте cls, сохраненные на шаге Export. В текстовом файле перейдите к методу, который вы хотите использовать по умолчанию, и добавьте следующую строку кода:

Значение атрибута. VB_UserMemId = 0

Директива Атрибут является инструкцией длякомпилятор, указывающий различные условия для компиляции. Директивы атрибутов не отображаются в редакторе VBA и не могут быть добавлены редактором VBA. Вы должны использовать текстовый редактор для добавления директив Attribute. Если вы делаете свойство Value членом по умолчанию для вашего класса, ваш код в Блокноте должен выглядеть примерно так:

Property Get Value() As Long
    Attribute Value.VB_UserMemId = 0
    Value = Whatever
End Property

Вы можете сделать Sub, Function или Property членом по умолчанию для класса, но только одна процедура в модуле может быть членом по умолчанию. Как только вы добавите директиву Attribute в текстовый файл, сохраните файл и выйдите из NotePad. Теперь в редакторе VBA перейдите в меню «Файл» и выберите «Импорт файла ...». В открывшемся диалоговом окне «Открыть» перейдите к папке, в которой вы сохранили файл cls, и импортируйте его в VBA. Поскольку директивы Attribute не видны в редакторе VBA, вы не увидите никаких изменений в своем коде.

После установки директивы Attribute вы можете использовать код, подобный следующему:

Dim CC As CMyClassName
Set CC = New CMyClassName
CC.Value = 123
' is the same as 
CC = 123

Answer 2

Хм, может быть ... в VB6 есть дополнение под названием "Генератор классов". Это позволит вам пометить свойство как «По умолчанию». Выполнение этого с вашим классом и открытие сохраненного файла * .cls в текстовом редакторе показывает, что VB6 просто добавляет строку к свойству, например,

Просмотр Редактор кода VB6:

Property Get coll() As Collection
    Set coll = zCollection
End Property

Просмотрв любом текстовом редакторе:

Property Get coll() As Collection
Attribute coll.VB_UserMemId = 0
    Set coll = zCollection
End Property

А Excel позволяет импортировать файлы. Adn Excel не жаловался при импорте файла * .cls, приведенного ниже.

Затем в VB6 работает следующий код:

Dim custColl As New MyCollection

With custColl
   .Add 11
   .Add 22
End With

Debug.Print custColl(1)   ' Prints '11'
Debug.Print custColl(2)   ' Prints '22'

Вот весь класс (без определениятакие детали, как ваш метод обработки ошибок) :

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "MyCollection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

Private Const modName = "CollectionClass"

Private zCollection As New Collection

Property Get coll() As Collection
Attribute coll.VB_UserMemId = 0
    Set coll = zCollection
End Property

Public Function Count() As Variant

10      On Error GoTo SUB_ERR

20      Count = zCollection.Count

SUB_EXIT:
30      Exit Function

SUB_ERR:

End Function

Public Sub Add(var As Variant)

10      On Error GoTo SUB_ERR

20      zCollection.Add var

SUB_EXIT:
30      Exit Sub

SUB_ERR:

End Sub

Public Sub Remove(loc As Long)

10      On Error GoTo SUB_ERR

20      zCollection.Remove loc

SUB_EXIT:
30      Exit Sub

SUB_ERR:

End Sub

Public Sub RemoveObj(var As Variant)

10      On Error GoTo SUB_ERR

20      Dim i As Long

30      If IsMissing(var) Then
40          Dim xxx As Integer: xxx = 1000000 'Errors if no var sent
50      Else
60          Select Case TypeName(var)
                Case "PartClass"
70                  Dim part As Object
80                  i = 1
90                  For Each part In zCollection
100                     If part Is var Then
110                         Me.Remove i
120                         Exit Sub
130                     End If
140                     i = i + 1
150                 Next
160             Case Else
170                 xxx = 1000000 'Errors if unknown Type Name
180         End Select
190     End If

SUB_EXIT:
200     Exit Sub

SUB_ERR:

End Sub

Public Function Contains(var As Variant) As Boolean

10      On Error GoTo FUNC_ERR

30      If IsMissing(var) Then
40          Dim xxx As Integer: xxx = 1000000 'Errors if no var sent
50      Else
60          Select Case TypeName(var)
                Case "PartClass"
70                  Dim part As Object
90                  For Each part In zCollection
100                     If part Is var Then
110                         Contains = True
120                         Exit Function
130                     End If
150                 Next
160             Case Else
170                 xxx = 1000000 'Errors if unknown Type Name
180         End Select
190     End If

FUNC_EXIT:
200     Exit Function

FUNC_ERR:

End Function

Я недостаточно знаком с редактором VB в Excel, чтобы провести быстрый тест, хотя

Answer 3

Невозможно, поскольку custColl (2) можно использовать только для ссылки на 2-ю пользовательскую коллекцию в массиве пользовательских коллекций.