Свои коллекции объектов

[Lama]

предисловие: при написании приложения к Excel на VBA оказалось, что самое простое реализовать задуманное - использовать пользовательские объекты, описываемые в модулях класса (Class module), однако для меня это новое дело. Что-то я узнал из хелпа к VBE, что-то из скаченных материалов и книг, но этой теме, т.е. пользовательским объектам, их описанию и использованию уделяется слишком мало внимания (на мой взгляд).

ближе к теме: разобравшись с пользовательскими объектами, я стал объединять их в коллекции. Исходя из определения коллекция - это группа объединенных однотипных объектов. Вот какой код я нашел в помощи для создания коллекции объектов:

Код: Выделить всё


Dim MyCollection As New Collection
Dim MyObject As New Class1*

MyCollection.Add item:=MyObject, key:=key
Set MyObject = Nothing


* конечно должен быть модуль класса с именем Class1 в котором описаны свойства и методы объекта

но таким образом можно в коллекцию добавить какой угодно объект, например WorkSheets(1), тем самым сломав всю структуру коллекции

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

[alibek]

Добавляешь ведь объекты в коллекцию ты. Просто не добавляй сторонние объекты.
Или создай два класса, один из которых будет родительским (коллекцией) и в его методе Add и проверяй тип добавляемого объекта.

[Igor_123]

Я сделал так: класс коллекция с таким кодом

Код: Выделить всё

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

'local variable to hold collection
Private mCol As Collection

Private mvarKey As String 'local copy

Public Property Get Key() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Key
    Key = mvarKey
End Property

Public Function AddObj(obj As clsAddData) As clsAddData

    Dim objNewMember As clsAddData
    Set objNewMember = New clsAddData
   
    objNewMember.FillAddData obj
    mCol.Add objNewMember, objNewMember.Key
   
    'return the object created
    Set AddObj = objNewMember
    Set objNewMember = Nothing
End Function

Public Function Add() As clsAddData
    'create a new object
    Dim objNewMember As clsAddData
    Set objNewMember = New clsAddData
    'set the properties passed into the method
    mCol.Add objNewMember, objNewMember.Key
   
    'return the object created
    Set Add = objNewMember
    Set objNewMember = Nothing
End Function

Public Property Get Item(vntIndexKey As Variant) As clsAddData
Attribute Item.VB_UserMemId = 0
  Set Item = mCol(vntIndexKey)
End Property

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

Public Sub Remove(vntIndexKey As Variant)
    mCol.Remove vntIndexKey
End Sub

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
    'this property allows you to enumerate
    'this collection with the For...Each syntax
    Set NewEnum = mCol.[_NewEnum]
End Property

Private Sub Class_Initialize()
    'creates the collection when this class is created
    Set mCol = New Collection
    mvarKey = TypeName(Me) & g_GenerateId.NewKeyForAll
End Sub

Private Sub Class_Terminate()
    'destroys collection when this class is terminated
    Set mCol = Nothing
End Sub

Public Sub Clear()
Do Until mCol.Count = 0
    mCol.Remove 1
Loop
End Sub

Функцмя FillAddData заполняет данными поля нового объекта или можно сделать как сказал alibek, проверять тип объекта и добавлять его

[Lama]

Добавляешь ведь объекты в коллекцию ты. Просто не добавляй сторонние объекты.
Или создай два класса, один из которых будет родительским (коллекцией) и в его методе Add и проверяй тип добавляемого объекта.

Идея мне нравиться, то есть вторая, пока только никак не соображу как это сделать (пока новичок ), если подскажешь на немудренном примере, ...
Спасибо!

[Lama]

Я сделал так: класс коллекция с таким кодом

Код: Выделить всё

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
...
    mCol.Remove 1
Loop
End Sub

Функцмя FillAddData заполняет данными поля нового объекта или можно сделать как сказал alibek, проверять тип объекта и добавлять его

очень уж сложно и мудрено!
если ты объяснишь по буквам, т.е. по ключевым строкам, а то в таком море кода я теряюсь

Спасибо!

[Igor_123]

Код: Выделить всё

'Все что идет до Option Explicit  это служебная информация для среды
'Настроить можно в свойствах, и я создавал класс ClassBuilder'ом, значения атрибутов устанавливал от
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsAddDatas"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Collection" ,"clsAddData"
Attribute VB_Ext_KEY = "Member0" ,"clsAddData"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"

Option Explicit
' Приватная коллекция, доступ к которой, только через свойства:
' на добавление существующего AddObj или нового Add.
' на получение элемента коллекции Item и для For Each - NewEnum
'local variable to hold collection
Private mCol As Collection

' мне нужен был какой-то ключ для уникальной идентификации вообще всех объектов в проекте
' заполняеться при инициализации класса глобальным объектом, который генерирует уникальные ключи
Private mvarKey As String 'local copy

' свойство для получения значения уникального ключа
Public Property Get Key() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Key
    Key = mvarKey
End Property

'функция для добавления существующего объекта
Public Function AddObj(obj As clsAddData) As clsAddData
   'все равно создаем новый объект
    Dim objNewMember As clsAddData
    Set objNewMember = New clsAddData
    'заполняет поля нового объекта
    objNewMember.FillAddData obj
    'добавляем в коллекцию
   mCol.Add objNewMember, objNewMember.Key
   
    'return the object created
    Set AddObj = objNewMember
    Set objNewMember = Nothing
End Function

Public Function Add() As clsAddData
   'все равно создаем новый объект
    'create a new object
    Dim objNewMember As clsAddData
    Set objNewMember = New clsAddData
    'set the properties passed into the method
   'добавляем в коллекцию
    mCol.Add objNewMember, objNewMember.Key
   
    'return the object created
    Set Add = objNewMember
    Set objNewMember = Nothing
End Function

Public Property Get Item(vntIndexKey As Variant) As clsAddData
Attribute Item.VB_UserMemId = 0
  Set Item = mCol(vntIndexKey)
End Property

'Восвращаем количество элементов в коллекции
Public Property Get Count() As Long
    Count = mCol.Count
End Property

'удаляем объект из коллекции
Public Sub Remove(vntIndexKey As Variant)
    mCol.Remove vntIndexKey
End Sub

'Это для цикла For Each
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
    'this property allows you to enumerate
    'this collection with the For...Each syntax
    Set NewEnum = mCol.[_NewEnum]
End Property

' Инициализация класса, конструктор
Private Sub Class_Initialize()
    'creates the collection when this class is created
   ' Создаем коллекцию
    Set mCol = New Collection
   ' и заполняем поле ключа
    mvarKey = TypeName(Me) & g_GenerateId.NewKeyForAll
End Sub

' Деструктор
Private Sub Class_Terminate()
    'destroys collection when this class is terminated
   'удаляем коллекцию
    Set mCol = Nothing
End Sub

'Очищаем коллекцию
Public Sub Clear()
' Пока коллекция не пуста, удаляем из неё элемент
Do Until mCol.Count = 0
    mCol.Remove 1
Loop
End Sub

[Lama]

резюме благодаря Igor'y 123 и alibek'y мне удалось разобраться в данном вопросе. В результате получисля такой код:

Код: Выделить всё


' Далее описан модуль класса Name=MyObjectClass
' Модельный объект имеет два свойства

Public Property1 As String
Public Property2 As String


Код: Выделить всё


' Далее описан модуль класса Name=MyCollectionClass
' Для того, чтобы объединить объекты в коллекцию и, чтобы обращаться к элементам этой коллекции привычным образом пришлось сделать так

Private MyCollection As New Collection
Private MyObject As New MyObjectClass


Public Sub Add()
    Dim Key As Long
   
    Key = MyCollection.Count + 1
    MyCollection.Add MyObject, CStr(Key)
   
End Sub

Public Function LetProperty(Key As Long, Property As String, Value As String) As MyObjectClass
    If Key > MyCollection.Count Then Exit Function
   
    Select Case Property
    Case "Property1"
        MyCollection(CStr(Key)).Property1 = Value
    Case "Property2"
        MyCollection(CStr(Key)).Property2 = Value
    End Select

End Function

Public Function GetProperty(Key As Long) As MyObjectClass
    If Key > MyCollection.Count Then Exit Function
   
        Set GetProperty = MyCollection(CStr(Key))

End Function

Property Get Count() As Long
   
    Count = MyCollection.Count
   
End Property


Код: Выделить всё


    ' Далее описано обращение к объекту из куска программы

    Dim MyCollection As New MyCollectionClass
   
    MyCollection.Add
   
    Call MyCollection.LetProperty(1, "Property1", "Value")
    a = MyCollection.GetProperty(1).Property1



единственное, что мне теперь не нравиться, это задание свойства элементу коллекции, если кто-то знает лучший способ ПОДСКАЖИТЕ, ПОЖАЛУЙСТА