View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Jamie Collins Jamie Collins is offline
external usenet poster
 
Posts: 593
Default Collections of Collections

David Morton wrote ...

Before I waste my time trying to figure out how to do it, is it possible to
make collections of collections of data? I have a system that has several
different items listed under one larger item, which is, in turn, part of a
group of like items. I suppose a query on a cost of a part would look
something like this:

? BigCollection("SerialNumber").Part("PartNumber").C ost

Is it possible to put my objects in heirarchial stages like that?


I think the term for this code construct is 'tunnelling'. I'm a great
fan of this kind of object model design. When implementing, I find it
easiest to have a parent class. For example:

m_Schema.Tables("MyTable").Columns("MyCol1").Name

This requires five classes:

CSchema
CTables
CTable
CColumns
CColumn

CSchema is the parent class. It has a property Tables, which returns
an instances of the CTables collection class (essentially a wrapper
for a underlying Collection object). CTables has an Item property
(wraps the Collection's Item method) which returns and instance of
CTable held in the Collection. CTable has a Columns property which
returns a CColumns object which has an Item property etc etc.

Excel is at a couple of a disadvantages over VB6.0 here. First, to get
the nice neat tunnelling as above, the Item property of the collection
classes must be the default member of the class, otherwise you'd have
to use the slightly less satisfactory:

m_Schema.Tables.Item("MyTable").Columns.Item(1).Na me

There is no native way of specifying the default value doing this in
Excel VBA but there is a 'hack': export the class, add the magic line
using a text editor then reimport to Excel.

Another disadvantage of Excel is that classes types are limited to
Private and PublicNotCreatable. Ideally, I'd like the parent CSchema
to be the only class in the model that can be instantiated:

Private m_Schema As CSchema
...
Set m_Schema = New CSchema

The child CTable class would only be creatable using:

Dim oTable As CTable
Set oTable m_Schema.Tables.Add(<required arguments)

Think of the Excel object model: you can't create a worksheet using:

Dim ws As Excel.Worksheet
Set ws = New Excel.Worksheet

but you can use:

Dim ws As Excel.Worksheet
Set ws = ThisWorkbook.Worksheets.Add

Although object creation cannot be restricted in this way use custom
classes, it remains a good model to follow.

The following is the bare essentials of the five classes and some code
to test the classes. To 'hack' the default member for the collection
classes (CTables and CColumns), follow the embedded instructions.

' <In a standard module ---
Option Explicit

Private m_Schema As CSchema

Sub Test()

Set m_Schema = New CSchema

m_Schema.Tables.Add("MyTable1").Columns.Add "MyCol1"

m_Schema.Tables(1).Columns.Add "MyCol2"

Dim oTable As CTable
Set oTable = m_Schema.Tables.Add("MyTable2")
oTable.Columns.Add "MyCol1"
oTable.Columns.Add "MyCol2"
oTable.Columns.Add "MyCol3"

MsgBox m_Schema.Tables("MyTable1").Columns(1).Name

MsgBox m_Schema.Tables(2).ColumnListDelimited

End Sub
' </In a standard module ---


' <CSchema ---
Option Explicit

Private m_Tables As CTables

Public Property Get Tables() As CTables
Set Tables = m_Tables
End Property

Private Sub Class_Initialize()
Set m_Tables = New CTables
End Sub
' </CSchema ---


' <CTables ---
Option Explicit

Private m_colTables As Collection

Public Property Get Item(ByVal Index As Variant) As CTable
'Attribute Item.VB_UserMemId = 0
' *** Export to a file, uncomment the above Attribute line using
' a text editor then re-import ***
On Error Resume Next
Set Item = m_colTables.Item(Index)
End Property

Public Property Get NewEnum() As IUnknown
'Attribute NewEnum.VB_UserMemId = -4
'Attribute NewEnum.VB_MemberFlags = "40"
' *** Export to a file, uncomment the above two Attribute lines using
' a text editor then re-import ***Set NewEnum =
m_colColumns.[_NewEnum]
Set NewEnum = m_colTables.[_NewEnum]
End Property

Friend Function Add(ByVal Name As String) As CTable

Dim oTable As CTable
Set oTable = New CTable

oTable.Init Name

m_colTables.Add oTable, Name

Set Add = oTable

End Function

Friend Property Get Count() As Long

Count = m_colTables.Count

End Property

Friend Function Remove(ByVal Index As Variant) As Boolean

On Error Resume Next
m_colTables.Remove Index
Remove = (Err.Number = 0)

End Function

Private Sub Class_Initialize()

Set m_colTables = New Collection

End Sub
' </CTables ---


' <CTable ---
Option Explicit

Private m_Columns As CColumns
Private m_strName As String

Private Sub Class_Initialize()

Set m_Columns = New CColumns

End Sub

Public Property Get Name() As String

Name = m_strName

End Property

Friend Function Init( _
ByVal Name As String _
) As Boolean

m_strName = Name

Init = True

End Function

Public Property Get Columns() As CColumns

Set Columns = m_Columns

End Property

Public Property Get ColumnListDelimited( _
Optional Delimiter As String = ", " _
) As String

Dim oColumn As CColumn
Dim strReturn As String

If Columns.Count < 1 Then
Exit Property
End If

For Each oColumn In m_Columns
strReturn = strReturn & oColumn.Name & Delimiter
Next

' Remove trailing delimiter
strReturn = Left$(strReturn, Len(strReturn) - Len(Delimiter))

ColumnListDelimited = strReturn

End Property
' </CTable ---


' <CColumns ---
Option Explicit

Private m_colColumns As Collection

Public Property Get Item(ByVal Index As Variant) As CColumn
'Attribute Item.VB_UserMemId = 0
' *** Export to a file, uncomment the above Attribute line using
' a text editor then re-import ***
On Error Resume Next
Set Item = m_colColumns.Item(Index)
End Property

Public Property Get NewEnum() As IUnknown
'Attribute NewEnum.VB_UserMemId = -4
'Attribute NewEnum.VB_MemberFlags = "40"
' *** Export to a file, uncomment the above two Attribute lines using
' a text editor then re-import ***Set NewEnum =
m_colColumns.[_NewEnum]
Set NewEnum = m_colColumns.[_NewEnum]
End Property

Friend Function Add( _
ByVal Name As String _
) As CColumn

Dim oColumn As CColumn
Set oColumn = New CColumn

oColumn.Init Name

m_colColumns.Add oColumn, Name

Set Add = oColumn

End Function

Friend Property Get Count() As Long

Count = m_colColumns.Count

End Property

Friend Function Remove(ByVal Index As Variant) As Boolean

On Error Resume Next
m_colColumns.Remove Index
Remove = (Err.Number = 0)

End Function

Private Sub Class_Initialize()

Set m_colColumns = New Collection

End Sub
' </CColumns ---


' <CColumn ---
Option Explicit

Private m_strName As String

Public Property Get Name() As String
Name = m_strName
End Property

Friend Function Init( _
ByVal Name As String _
) As Boolean

m_strName = Name

Init = True

End Function
' </CColumn ---


Jamie.

--