Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Klassen in Klassen
zurück: Arrays in Klassen weiter: Februar-Problem bei Formel TAGE360 beseitigen Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Tutorial Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
Isabelle :-)
Menschin


Verfasst am:
26. Aug 2012, 21:37
Rufname:
Wohnort: Westlicher Spiralarm der Galaxis


Klassen in Klassen - Klassen in Klassen

Nach oben
       Version: Office 2k (2000)

Hallöchen,

du kennst das aus dem Lokal- bzw. Überwachungsfenster wenn du ein Objekt aufklappst. Da finden sich im Objekt wieder Objekte die sich aufklappen lassen. Solche Strukturen lassen sich natürlich auch mit selbst erstellten Klassen nachbilden. Dazu habe ich zwei Beispiele erstellt. 1. Ein Klassenarray dessen Elemente ein Array einer Klasse enthält dessen Elemente wiederum ein Array einer Klasse enthält und 2. Eine Auflistungsklasse deren Elemente wieder eine Auflistungsklasse enthalten.

Beispiel 1

In einem Standardmodul:

Code:
Option Explicit

Private lobjMachine() As clsMachine

Public Sub Test()

    Dim ialngMachine As Long, ialngOrder As Long, ialngProduct As Long

    ReDim Preserve lobjMachine(ialngMachine)

    Set lobjMachine(ialngMachine) = New clsMachine

    With lobjMachine(ialngMachine)

        .MachineNumber = "Maschine 1"

        For ialngOrder = 0 To 9

            Set .Order(ialngOrder) = New clsOrder

            With .Order(ialngOrder)

                .OrderNumber = "Auftrag " & CStr(ialngOrder)

                For ialngProduct = 0 To 19

                    Set .Product(ialngProduct) = New clsProduct

                    .Product(ialngProduct).ProductNumber = "Produkt " & CStr(ialngProduct)

                Next
            End With
        Next
    End With

    MsgBox lobjMachine(0).Order(3).Product(5).ProductNumber

    Set lobjMachine(ialngMachine) = Nothing

End Sub

In einem Klassenmodul mit dem Namen "clsMachine":

Code:
Option Explicit

Private mstrMachine As String
Private maobjOrder() As clsOrder

Private Sub Class_Initialize()
    ReDim maobjOrder(0)
End Sub

Private Sub Class_Terminate()
    Dim ialngIndex As Long
    For ialngIndex = LBound(maobjOrder) To UBound(maobjOrder)
        Set maobjOrder(ialngIndex) = Nothing
    Next
End Sub

Friend Property Get MachineNumber() As String
    MachineNumber = mstrMachine
End Property

Friend Property Let MachineNumber(ByVal pvstrMachine As String)
    mstrMachine = pvstrMachine
End Property

Friend Property Get Order(ByVal pvialngIndex As Long) As clsOrder
    If UBound(maobjOrder) < pvialngIndex Then Set Order(pvialngIndex) = New clsOrder
    Set Order = maobjOrder(pvialngIndex)
End Property

Friend Property Set Order(ByVal pvialngIndex As Long, ByRef probjOrder As clsOrder)
    If UBound(maobjOrder) < pvialngIndex Then ReDim Preserve maobjOrder(pvialngIndex)
    Set maobjOrder(pvialngIndex) = probjOrder
End Property

In einem Klassenmodul mit dem Namen " clsOrder":

Code:
Option Explicit

Private maobjProduct() As clsProduct
     
Private mstrOrderNumber As String

Private Sub Class_Initialize()
    ReDim maobjProduct(0)
End Sub

Private Sub Class_Terminate()
    Dim ialngIndex As Long
    For ialngIndex = LBound(maobjProduct) To UBound(maobjProduct)
        Set maobjProduct(ialngIndex) = Nothing
    Next
End Sub

Friend Property Get OrderNumber() As String
    OrderNumber = mstrOrderNumber
End Property

Friend Property Let OrderNumber(ByVal pvstrOrder As String)
    mstrOrderNumber = pvstrOrder
End Property

Friend Property Get Product(ByVal pvialngIndex As Long) As clsProduct
    If UBound(maobjProduct) < pvialngIndex Then Set Product(pvialngIndex) = New clsProduct
    Set Product = maobjProduct(pvialngIndex)
End Property

Friend Property Set Product(ByVal pvialngIndex As Long, ByRef probjProduct As clsProduct)
    If UBound(maobjProduct) < pvialngIndex Then ReDim Preserve maobjProduct(pvialngIndex)
    Set maobjProduct(pvialngIndex) = probjProduct
End Property

In einem Klassenmodul mit dem Namen " clsProduct":
Code:
Option Explicit

Private mstrProductNumber As String

Friend Property Get ProductNumber() As String
    ProductNumber = mstrProductNumber
End Property

Friend Property Let ProductNumber(ByVal pvstrProductNumber As String)
    mstrProductNumber = pvstrProductNumber
End Property


Beispiel 2

In einem Standardmodul:

Code:
Option Explicit

Public Sub Test()

    Dim objContactClass As clsContact
    Dim objContactItem As clsContact
    Dim objTelephoneItem As clsTelephone

    'Neue Instanz der Kontak-Klasse erstellen
    Set objContactClass = New clsContact

    'Kontakt hinzufuegen
    Call objContactClass.Add("Maier", "Herbert")
    'Telefonnummern zum Kontakt hinzufuegen
    With objContactClass("Maier").Telephone
        Call .Add("Privat", "0123 / 45 67 89")
        Call .Add("Mobil", "0789 / 12 39 87 258")
        Call .Add("Geschäft", "0122 / 787 1245")
    End With

    'Kontakt hinzufuegen
    Call objContactClass.Add("Huber", "Renate")
    'Telefonnummern zum Kontakt hinzufuegen
    With objContactClass("Huber").Telephone
        Call .Add("Privat", "0131 / 78 87 22")
        Call .Add("Mobil1", "0715 / 45 58 32 904")
        Call .Add("Mobil2", "0712 / 36 37 32 409")
        Call .Add("Geschäft", "0122 / 787 1253")
    End With

    'Kontakt hinzufuegen
    Call objContactClass.Add("Müller", "Bernhard")
    'Telefonnummern zum Kontakt hinzufuegen
    With objContactClass("Müller").Telephone
        Call .Add("Privat", "0135 / 46 33 95")
        Call .Add("Mobil", "0712 / 56 85 29 772")
        Call .Add("Geschäft", "0122 / 787 1221")
    End With

    'Schleife ueber alle Kontakte
    For Each objContactItem In objContactClass

        MsgBox objContactItem.Name & " / " & objContactItem.PreName

        'Telefonnummern und Standorte eines Kontaktes ausgeben
        For Each objTelephoneItem In objContactItem.Telephone

            With objTelephoneItem

                MsgBox .Location & vbTab & .Number

            End With
        Next
    Next

    'Klassenobjekt freigeben
    Set objContactClass = Nothing

End Sub

In einem Klassenmodul mit dem Namen " clsContact":

Code:
Option Explicit

Private mobjContact As Collection
Private mobjTelephoneClass As clsTelephone
Private mstrName As String
Private mstrPreName As String

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

Private Sub Class_Terminate()
    Set mobjContact = Nothing
End Sub

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

Public Property Let Name(ByVal pvstrName As String)
    mstrName = pvstrName
End Property

Public Property Get PreName() As String
    PreName = mstrPreName
End Property

Public Property Let PreName(ByVal pvstrPreName As String)
    mstrPreName = pvstrPreName
End Property

Friend Property Get Telephone() As clsTelephone
    Set Telephone = mobjTelephoneClass
End Property

Friend Property Set Telephone(ByRef probjTelephone As clsTelephone)
    Set mobjTelephoneClass = probjTelephone
End Property

Public Sub Add(ByVal pvstrName As String, ByVal pvstrPreName As String)
    Dim objContact As clsContact
    Set objContact = New clsContact
    Set objContact.Telephone = New clsTelephone
    objContact.Name = pvstrName
    objContact.PreName = pvstrPreName
    mobjContact.Add objContact, objContact.Name
    Set objContact = Nothing
End Sub

Public Function Count() As Long
    Count = mobjContact.Count
End Function

Public Sub Delete(ByVal pvvntIndex As Variant)
    Call mobjContact.Remove(pvvntIndex)
End Sub

Public Function Item(ByVal pvvntIndex As Variant) As clsContact
'Attribute Item.VB_UserMemId = 0
    Set Item = mobjContact.Item(pvvntIndex)
End Function

Public Function NewEnum() As IUnknown
'Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = mobjContact.[_NewEnum]
End Function

In einem Klassenmodul mit dem Namen " clsTelephone":
Code:
Option Explicit

Private mobjTelephone As Collection
Private mstrLocation As String
Private mstrNumber As String

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

Private Sub Class_Terminate()
    Set mobjTelephone = Nothing
End Sub

Friend Property Get Location() As String
    Location = mstrLocation
End Property

Friend Property Let Location(ByVal pvstrLocation As String)
    mstrLocation = pvstrLocation
End Property

Friend Property Get Number() As String
    Number = mstrNumber
End Property

Friend Property Let Number(ByVal pvstrNumber As String)
    mstrNumber = pvstrNumber
End Property

Friend Sub Add(ByVal pvstrLocation As String, ByVal pvstrNumber As String)
    Dim objTelephone As clsTelephone
    Set objTelephone = New clsTelephone
    With objTelephone
        .Location = pvstrLocation
        .Number = pvstrNumber
    End With
    mobjTelephone.Add objTelephone
    Set objTelephone = Nothing
End Sub

Friend Function Count() As Long
    Count = mobjTelephone.Count
End Function

Friend Sub Delete(pvntIndex As Variant)
    mobjTelephone.Remove pvntIndex
End Sub

Public Function Item(pvntIndex As Variant) As clsTelephone
'Attribute Item.VB_UserMemId = 0
    Set Item = mobjTelephone.Item(pvntIndex)
End Function

Public Function NewEnum() As IUnknown
'Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = mobjTelephone.[_NewEnum]
End Function

Wie das mit der Standardeigenschaft und For – Each funktioniert habe ich hier: http://www.office-loesung.de/ftopic544234_0_0_asc.php schon mal beschrieben.

_________________
LG Isi

Die Mitgliedschaft im Forum erhöht deine Chance auf eine Antwort von mir um 99,999%
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel Hilfe: *T*AW: Spezielle Klassen - Teil 1 - QueryTable 2 Ephedra 70 20. Aug 2013, 11:14
Ephedra *T*AW: Spezielle Klassen - Teil 1 - QueryTable
Keine neuen Beiträge Excel VBA (Makros): Klassen beim Debuggen überspringen? 6 SG ;-) 86 18. Aug 2013, 17:19
SG ;-) Klassen beim Debuggen überspringen?
Keine neuen Beiträge Excel VBA (Makros): Verständnisfrage zu Klassen 4 kurochan 100 01. Jul 2013, 18:36
kurochan Verständnisfrage zu Klassen
Keine neuen Beiträge Excel VBA (Makros): Grundsatzfrage: Aufruf von Eigenschaften in Klassen 1 cd1001 89 16. Jun 2013, 17:47
cd1001 Grundsatzfrage: Aufruf von Eigenschaften in Klassen
Keine neuen Beiträge Excel Tipps & Tricks: Spezielle Klassen - Teil 5 - Application 0 Isabelle :-) 518 28. Apr 2013, 00:45
Isabelle :-) Spezielle Klassen - Teil 5 - Application
Keine neuen Beiträge Excel Tipps & Tricks: Spezielle Klassen - Teil 3 - CommandBarEvents 1 Nepumuk 1606 12. Mai 2012, 14:22
Thomas Ramel Spezielle Klassen - Teil 3 - CommandBarEvents
Keine neuen Beiträge Excel Tipps & Tricks: Spezielle Klassen - Teil 2 - CommandBarButton 1 Nepumuk 1912 12. Mai 2012, 14:22
Thomas Ramel Spezielle Klassen - Teil 2 - CommandBarButton
Keine neuen Beiträge Excel Tipps & Tricks: Spezielle Klassen - Teil 1 - QueryTable 1 Nepumuk 4252 12. Mai 2012, 14:22
Thomas Ramel Spezielle Klassen - Teil 1 - QueryTable
Keine neuen Beiträge Excel VBA (Makros): Diskussion über Klassen in VBA 14 Isabelle :-) 1844 28. Sep 2011, 19:01
KeepCoolMan Diskussion über Klassen in VBA
Keine neuen Beiträge Excel VBA (Makros): Eigene Events in eigenen Klassen 4 Gast 1029 06. Sep 2011, 20:55
Gast Eigene Events in eigenen Klassen
Keine neuen Beiträge Excel Auswertungen: Häufigkeit in Klassen bei Tabelle mit Autofilter 18 dominik_rz 1348 10. Aug 2011, 20:51
Thomas Ramel Häufigkeit in Klassen bei Tabelle mit Autofilter
Keine neuen Beiträge Excel Formeln: Häufigkeit in Klassen/Gruppen mit verschiedener Anzahl 4 Baileysss 922 11. Mai 2011, 20:10
Baileysss Häufigkeit in Klassen/Gruppen mit verschiedener Anzahl
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: MS Frontpage