XL 2016 Depuis un Module Standard pouvoir Récupérer la Photocopie d'une Classe (dont/Avec) la collection qui est incluse dans le Module de Classe.

laurent950

XLDnaute Accro
Bonjour Le Forum,

J'ai réalisé un Module de classe (CPays) avec une Variable de Type Collection (Coll) qui inclut dans le Module de classe.

Le Principe avec une boucle For je viens Créer une nouvelle instance à chaque itération
de l'objet Pays, dont je me sers pour remplir cette classe.

Je souhaite une fois cette classe remplie consigner cette classe dans la collection qui elle est incluse dans le module de classe.

Par la suite je souhaite appeler cette collection depuis le module standard, car cette collection se trouve dans le module de classe, avec un code pour y retrouver la photocopie de la classe correspondante a ce qui a était précédemment enregistré et remplis !

J'ai réalisé la macro, mais cela ne fonctionne pas.

En Exemple :
j'ai écrit le code, dans la zone de texte sur la Feuil à côté du tableau structurée.
la collection se situe dans le module standard, et cela me renvois les bon résultat.
je souhaite l'inverse la collection dans le module de classe et aucune collection dans le module standard.

Je poste le code qui ne fonctionne pas ci-dessous avec le fichier joint.

Si vous avez l'explication et même la solution je vous remercie car je ne trouve pas la solution après plusieurs recherches ?

Module Standard : Ci-Dessous

VB:
Sub CollectionDansModuleDeClasse()

Dim data As Variant ' ............................................................. 1)
data = Sheets("Collections").ListObjects(1).DataBodyRange.Value2 ' ................ 1)
Dim i As Long ' ................................................................... 1)

Dim PaysGlobal As New ClsPays ' ................................................... 2)

Dim Pays As ClsPays ' ............................................................. 3)

For i = 1 To UBound(data, 1) ' .................................................... 1)
    Set Pays = PaysGlobal.Item(data(i, 1))
    Set Pays = Pays
    Pays.Code = data(i, 1) ' ...................................................... 4)
    Pays.Nom = data(i, 2) ' ....................................................... 4)
    Pays.Capitale = data(i, 3) ' .................................................. 4)
Next i

For i = 1 To UBound(data, 1)
    Set Pays = Pays.TransferCollection(data(i, 1)) ' .............................. Bloque) Un seule Item est remplis avec mauvais code !
        Debug.Print Pays.Code, Pays.Nom, Pays.Capitale
Next i
End Sub

Module De Classe(ClsPays) : Ci-Dessous

Code:
Private mCode As String
Private mNom As String
Private mCapitale As String
Private mCLn As Collection
'
Property Get Code() As String
    Code = mCode
End Property
Property Let Code(ByVal NewValue As String)
    mCode = NewValue
End Property
'
Property Get Nom() As String
    Nom = mNom
End Property
Property Let Nom(ByVal NewValue As String)
    mNom = NewValue
End Property
'
Property Get Capitale() As String
    Capitale = mCapitale
End Property
Property Let Capitale(ByVal NewValue As String)
    mCapitale = NewValue
End Property
'
Property Get PhtosCopieClassWithKey() As String
    Capitale = mCapitale
End Property
'
Public Function TransferCollection(ByVal NewValue As String) As ClsPays
   Set TransferCollection = mCLn(NewValue)
End Function
Private Sub Class_Initialize()
   Set mCLn = New Collection
   End Sub
Public Function Item(ByVal NewValue As String) As ClsPays
   On Error Resume Next
   Set Item = mCLn(NewValue)
   If Err Then
      Set Item = New ClsPays
      Set Item = Me
      mCLn.Add Item, NewValue
   End If
   End Function
 

Pièces jointes

  • Test Module de classe Inclus Object Collection.xlsm
    31.7 KB · Affichages: 6
Dernière édition:

laurent950

XLDnaute Accro
Bonsoir @Dranreb , @patricktoulon

Merci Dranreb pour cette explication car je me suis inspiré d'un de vos code en module de classe dont il y avait une collection incluse dans le module de classe, mais il n'y avait aucune collection dans le module standard, c'est pour cela que j'ai essayé ? mais sans succès.

J'aimerais bien décortiqué votre code @Dranreb pour enfin le comprendre car cela touche a sa fin.
Je vous Poste le code dont je me suis inspiré pour essayé de reproduire votre code qui est super efficace mais très complexe aussi :

En Poste #41 pour votre fichier et retrouver le contexte.
lien : https://excel-downloads.com/threads...ence-en-base-de-donnees.20059069/page-3#posts

J'ai vraiment envie de comprendre se code que vous avez fait j'en suis plus très loin maintenant je pense, il me manque des briques encore.

Ps : @patricktoulon était aussi dans la conversation.

Merci aussi a toi @patricktoulon de m'avoir répondu, je pense avoir saisie se que tu viens de m'expliqué je pense c'est différent du code de @Dranreb, je vais poster un essaie de se que tu m'as expliqué en Poste #3

Votre Module standard
VB:
Option Explicit
Sub ConcatDésign()
   Dim RngDon As Range, TDon(), LD As Long, TSpl() As String, TRés(), LR As Long, _
      RubGlobale As New Rubrique, SsRub As Rubrique, P As Integer, C As Integer
   Set RngDon = PlgUti(Feuil1.[A2])
       TDon = RngDon.Value
   For LD = 1 To UBound(TDon, 1)
      If TDon(LD, 1) <> "" Then
         TSpl = Split(TDon(LD, 1), ".")
         Set SsRub = RubGlobale.Item(TSpl(0))
             For P = 1 To UBound(TSpl)
                 Set SsRub = SsRub.Item(TSpl(P))
             Next P '+ 1 après sortie
         SsRub.Txt = TDon(LD, 2)
         End If
   Next LD
   ReDim TRés(1 To UBound(TDon, 1), 1 To 7)
   For LD = 1 To UBound(TDon, 1)
      If Not IsEmpty(TDon(LD, 4)) Then
         LR = LR + 1
         TSpl = Split(TDon(LD, 1), ".")
         Set SsRub = RubGlobale
         For P = 0 To UBound(TSpl)
            Set SsRub = SsRub.Item(TSpl(P))
            TSpl(P) = SsRub.Txt: Next P
         If UBound(TSpl) > 0 Then ReDim Preserve TSpl(0 To UBound(TSpl) - 1)
         TRés(LR, 1) = "'" & TDon(LD, 1)
         TRés(LR, 2) = Join(TSpl, " - ")
         TRés(LR, 3) = SsRub.Txt
         For C = 4 To 7: TRés(LR, C) = TDon(LD, C - 1): Next C
         End If: Next LD
   Feuil3.[A2:E10000].ClearContents
   Feuil3.[A2:E2].Resize(LR).Value = TRés
   Feuil3.[A:E].Columns.AutoFit
   End Sub
Function PlgUti(ByVal PlageDép As Range, Optional ByVal PlagExam As Range = Nothing, _
   Optional ByVal LMin As Long, Optional ByVal CMin As Long) As Range
Rem. ——— Plage renseignée de plus qu'une chaîne vide à partir de PlageDép dans PlageExam assumé UsedRange si non précisé.
   Dim LMax As Long, CMax As Long, NbL As Long, NbC As Long
   On Error GoTo RienTrouvé
   If PlagExam Is Nothing Then Set PlagExam = PlageDép.Worksheet.UsedRange
   LMax = PlagExam.Find("*", PlagExam.Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
   CMax = PlagExam.Find("*", PlagExam.Cells(1, 1), xlValues, xlWhole, xlByColumns, xlPrevious).Column
   On Error GoTo 0
   NbL = LMax - PlageDép.Row + 1: If NbL < LMin Then NbL = LMin
   NbC = CMax - PlageDép.Column + 1: If NbC < CMin Then NbC = CMin
   If NbL < 1 Or NbC < 1 Then GoTo CEstToutVide
   Set PlgUti = PlageDép.Resize(NbL, NbC)
   Exit Function
RienTrouvé: Resume CEstToutVide
CEstToutVide: Set PlgUti = Nothing
   End Function

Votre module de classe : Rubrique

Code:
Option Explicit
Private LaParente As Rubrique, LesChapitres As String, LeTexte As String, CLn As Collection
Private Sub Class_Initialize()
   Set CLn = New Collection
   End Sub
Public Sub Init(ByVal Owner As Rubrique, ByVal Chapitres As String)
   Set LaParente = Owner
   LesChapitres = Chapitres
   LeTexte = "?"
   End Sub
Public Function Item(ByVal Rub As String) As Rubrique
   On Error Resume Next
   Set Item = CLn(Rub)
   If Err Then
      Set Item = New Rubrique
      Item.Init Me, LesChapitres & "." & Rub
      CLn.Add Item, Rub: End If
   End Function
Function Parent() As Rubrique
   Set Parent = LaParente
   End Function
Function Chapitres() As String
   Chapitres = Mid$(LesChapitres, 2)
   End Function
Property Let Txt(ByVal Texte As String)
   If LeTexte <> "?" And Texte <> LeTexte Then
      Select Case MsgBox("Texte """ & LeTexte & """ à" & vbLf & "remplacer par """ _
         & Texte & """ ?", vbExclamation + vbYesNoCancel, "Rubrique " & Chapitres)
         Case vbCancel: End
         Case vbNo: Exit Property
         End Select
      End If
   LeTexte = Texte
   End Property
Property Get Txt() As String
   Txt = LeTexte
   End Property
 

Dranreb

XLDnaute Barbatruc
un de vos code en module de classe dont il y avait une collection incluse dans le module de classe, mais il n'y avait aucune collection dans le module standard
Si, mais généralement renvoyée par une Function Gigogne, également en module standard, qui renvoie effectivement une Collection d'objets SsGr, lesquels son munis d'une collection Co réservée à des sous-éléments. Il peut arriver que je déclare cette collection et l'initialise par un Sel ClnDon = Gigogne(etc., mais c'est rare, le plus souvent je fais un grand For Each SGrPrinc In Gigogne(etc …
 
Dernière édition:

laurent950

XLDnaute Accro
Pour @patricktoulon

Si j'ai compris le code serait comme cela :
Avec une classe appelée ClsPays et qui gérer une collection de pays à l'intérieur de cette classe.

Créez la classe ClsPays :
Dans cette classe il faut définir les propriétés et méthodes nécessaires.

Module de classe : ClsPays
Code:
' Dans la classe ClsPays

Private pCountryName As String
Private pPopulation As Long

Public Property Get CountryName() As String
    CountryName = pCountryName
End Property

Public Property Let CountryName(ByVal value As String)
    pCountryName = value
End Property

Public Property Get Population() As Long
    Population = pPopulation
End Property

Public Property Let Population(ByVal value As Long)
    pPopulation = value
End Property

Puis créez une autre classe (peut-être appelée ClsCountryCollection) pour gérer la collection de pays à l'intérieur de la classe ClsPays.

Module de classe : ClsCountryCollection

Code:
' Dans la classe ClsCountryCollection

Private Countries As Collection

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

Public Sub AddCountry(ByVal Country As ClsPays)
    Countries.Add Country
End Sub

Public Function GetCountryCount() As Long
    GetCountryCount = Countries.Count
End Function

Public Function GetCountryByIndex(ByVal Index As Long) As ClsPays
    If Index >= 1 And Index <= Countries.Count Then
        Set GetCountryByIndex = Countries(Index)
    End If
End Function

Et depuis le module standard :
pouvoir utiliser ces classes dans un module standard
pour créer des instances de pays et gérer la collection :

VB:
Sub TestCountryCollection()
    Dim CollectionOfCountries As New ClsCountryCollection
    Dim Country1 As New ClsPays
    Dim Country2 As New ClsPays
    
    Country1.CountryName = "France"
    Country1.Population = 67000000
    
    Country2.CountryName = "Germany"
    Country2.Population = 83000000
    
    CollectionOfCountries.AddCountry Country1
    CollectionOfCountries.AddCountry Country2
    
    MsgBox "Number of countries: " & CollectionOfCountries.GetCountryCount
    
    Dim Index As Long
    For Index = 1 To CollectionOfCountries.GetCountryCount
        Dim CurrentCountry As ClsPays
        Set CurrentCountry = CollectionOfCountries.GetCountryByIndex(Index)
        MsgBox CurrentCountry.CountryName & " has population " & CurrentCountry.Population
    Next Index
End Sub

C'est cela @patricktoulon ?

Pour Ma pars je souhaite vraiment comprendre le code a @Dranreb qui me satisfait beaucoup, c'est très ingénieux mais je me perd dans les chemins du model objet a @Dranreb souvent.
 

patricktoulon

XLDnaute Barbatruc
tiens un exemple hyper simple et sans fonction gigogne ;)
le module classe
VB:
Public tout_les_pays As Collection
Public personne As String
Public lepays As String
Dim classe As lespays
Public Function AddPays(ByVal p As String, ByVal nom As String)
    If tout_les_pays Is Nothing Then Set tout_les_pays = New Collection
    Set classe = New lespays
    classe.lepays = p
    classe.personne = nom
    tout_les_pays.Add classe
End Function

maintenant je l'appelle du module standard

VB:
Dim international As New lespays
Sub test()
    international.AddPays "france", "laurent"
    international.AddPays "espagne", "diego"
    international.AddPays "canada", "yvanan"

    MsgBox "il y a " & international.tout_les_pays.Count & " pays d'enregistré"

    For i = 1 To international.tout_les_pays.Count
        With international.tout_les_pays(i)
            MsgBox .lepays & " pour " & .personne
        End With
    Next
End Sub

comme tu peux le voir la collection utilisée est celle de l'instance "internationale" du module standard
de ce fait je poursuis mon exemple en l'exploitant dans des msgbox
le count par exemple on l'obtient sans fonction gigogne avec le count de l'object collection directement

si je veux tout vider je met a nothing internationale

voila voila ;)
 

laurent950

XLDnaute Accro
Si, mais généralement renvoyée par une Function Gigogne, également en module standard, qui renvoie effectivement une Collection d'objets SsGr, lesquels son muni d'une collection Co réservée à des sous-éléments
Merci @Dranreb c'est exactement que je voudrait apprendre et conceptualisé. j'ai du mal avec cela.

c'est possible de l'appliqué à cette exemple que j'ai posté en Poste 1 ?
La fonction Gigogne est top, le principe
 

laurent950

XLDnaute Accro
@patricktoulon
Merci pour ce code qui est d'une autres approche plus simple effectivement, je e suis perdu a un moment dans le code a cette endroit.
international.tout_les_pays.Count
Comment il va rerchercher la variable Collection dans le module de classe ? je suis perdu j'arrive pas a remonter a l'objet collection.

C'est parceque la variable est publique dans le module de classe ?
Public tout_les_pays As Collection
elle suit tous les module lorsqu'elle est initialisé au fur et a mesure qu'elle est remplis ?
 

Dranreb

XLDnaute Barbatruc
Il est probable que ma fonction Gigogne puisse être utilisée pour ranger vos données, mais ça dépend de ce que vous voulez obtenir à la fin. L'objet SsGr a vocation à rester banalisé. La propriété Co de ceux du dernier niveau contient simplement des tableaux reprenant les valeurs des données de départ.
 

patricktoulon

XLDnaute Barbatruc
re
Comment il va rerchercher la variable Collection dans le module de classe ? je suis perdu j'arrive pas a remonter a l'objet collection.

C'est parceque la variable est publique dans le module de classe ?
Public tout_les_pays As Collection
elle suit tous les module lorsqu'elle est initialisé au fur et a mesure qu'elle est remplis ?
c'est bien je n'ai plus a me fatiguer tu pose la question et donne la réponse en même temps
🤣 🤣

msgbox typename(international.tout_les_pays)

mais entre nous et pour la Nème fois que je te le dis
pour ce genre de truc(element.propertie) une simple variable type suffit

il serait intéressant aussi de regarder les dictionnaires comme ca on peut directement appeler une instance par le nom du pay je n'ai jamais essayer il faudra que le le fasse
ou alors avec une routine enum
 

laurent950

XLDnaute Accro
Il est probable que ma fonction Gigogne puisse être utilisée pour ranger vos données
C'est exactement se que je souhaite, je souhaite comprendre et assimilé votre principe, je vais préparer un exemple basé sur votre code dont je me suis inspiré.

Peut être comme cela
1692915952294.png


La Matrice = Le tableau Structuré
L'arborescence pour comprendre la fonction Gigogne
Soit
1 = il n'y a pas de sous arborescence : Soit juste une collection a avec la copie de la classe
Code (AT) / Pays (Autriche) / Ville (Vienne) ---->>> pour 1
si
5.1 = Il y a une sous arborescence : Soit une collection qui sera avec un code
Par exemple DE
Puis cette collection va contenir la sous arborescence soit la copie de 3 Classes dans cette collection
Code (DE) / Pays (Allemagne) / Ville (Berlin) ---->>> pour 5.1
Code (DE) / Pays (Allemagne) / Ville (Munich) ---->>> pour 5.2
Code (DE) / Pays (Allemagne) / Ville (Constance) ---->>> pour 5.3


C'est l'idée pour comprendre et pouvoir reproduire votre code gigogne et les collections qui sont des photocopies des classes en utilisant les propriété Property : Set / Let / Get au maximum et apprendre sans raccourci comme vos codes super bien établit @Dranreb

Je sais pas si l'exemple et parlant ?
 

patricktoulon

XLDnaute Barbatruc
allez je vais même plus loin
le maitre mère de toute les autre devient enfant de ses enfant
on marche sur la tête LOL
LE MODULE CLASSE
VB:
Public tout_les_pays As Collection
Public personne As String
Public lepays As String
Public lesautres As lespays
Dim classe As lespays
Public Function AddPays(ByVal p As String, ByVal nom As String)
    If tout_les_pays Is Nothing Then Set tout_les_pays = New Collection
    Set classe = New lespays
    classe.lepays = p
    classe.personne = nom
    Set classe.lesautres = Me
    tout_les_pays.Add classe
End Function

VB:
Dim international As New lespays
Sub test()
    international.AddPays "france", "laurent"
    international.AddPays "espagne", "diego"
    international.AddPays "canada", "yvanan"

    MsgBox "il y a " & international.tout_les_pays.Count & " pays d'enregistré"

    For i = 1 To international.tout_les_pays.Count
        With international.tout_les_pays(i)
            MsgBox .lepays & " pour " & .personne
        End With
    Next
    ' et je vais même plus loin !!!!!
    ' l'instance maitre (parent de toute les autre devient en même temps l'enfant de toute les autre  :):):):)
    'exemple
    'je recupere l'espagne
    'et je vais lister tout les pay :):):):):):)
    'bon d'accords il y a de quoi en perdre la boule  mais bon c'est rigolo non
    With international.tout_les_pays(2).lesautres
        For i = 1 To .tout_les_pays.Count
            MsgBox " c'est   à  en perdre la boule " & vbCrLf & .tout_les_pays(i).lepays & " pour " & .tout_les_pays(i).personne
        Next
    End With
End Sub

HA !!!.. on se marre bien ici je reviendrais
 

Discussions similaires

Statistiques des forums

Discussions
312 206
Messages
2 086 223
Membres
103 159
dernier inscrit
FBallea