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 Barbatruc
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:

Dranreb

XLDnaute Barbatruc
Ce choix de la taille initiale du tableau n'a pas de rapport avec le maxi possible d'un Long.
RàZArgument libère de la mémoire prise par les variables globales et peut préparer une nouvelle utilisation ultérieure. Je n'ai pas vérifié …
 
Dernière édition:

laurent950

XLDnaute Barbatruc
@Dranreb

J'ai décortiqué tous votre code mais je mis suis perdu dans les chemins, j'ai essayé de faire quelques choses de simple et condensé mais j'enregistre toujours un seul Item de la classe, c'est a dire le dernier.

ici ca fonctionne juste avec un seul code ?
Public Function TransfertClass(ByVal NewValue As String) As ClsPays
Set TransfertClass = mCLn.Item(NewValue)
End Function

Puis comme il y a plusieurs code impossible de deviné le bon code NewValue

si j'écrit en dur le bon code ca passe
Set TransfertClass = mCLn.Item("EE") ?

Vous avez la solution ? je me suis perdu dans les chemins gigogne alors je repart de quelques choses de très simple au possible.
 

Pièces jointes

  • LaurentGigogneLaurent950.xlsm
    22.9 KB · Affichages: 2

Dranreb

XLDnaute Barbatruc
Je ne comprends pas cette obstination à ne pas utiliser ma fonction Gigogne telle qu'elle est, même sans comprendre entièrement comment elle procède, ce qui n'est pas nécessaire.
L'objet SsGr est aussi muni de quelques méthodes que vous pourriez peut être étudier …
 

laurent950

XLDnaute Barbatruc
@Dranreb

Lorsque la collection est dans le Module standard cela fonctionne bien
Coll.Add pays ' .................Ajoute le pays(Module de Classe) à la collection(Coll)

VB:
For i = 1 To UBound(data, 1)
   Set pays = New CPays ' ......... Crée et initialise l'objet Pays(Module de Classe)
       pays.Code = data(i, 1) ' ... Initialise la classe pour le Code
       pays.Nom = data(i, 2) ' .... Initialise la classe pour le Nom
       pays.Capitale = data(i, 3) ' Initialise la classe pour la Capitale
   Coll.Add pays ' .................Ajoute le pays(Module de Classe) à la collection(Coll)
Next i

Fichier Excel Joint avec le code qui fonctionne sur ce Poste #36


'**********************************************************************************************

J'essaie l'inverse, la collection dans le Module de Classe
est aucune collection dans un module standard
passé la classe remplis dans la collection qui est inclus a ce module de classe
mais impossible
j'essaie de construire dans l'autre sens pour comprendre ?
mais lorsque que la collection est dans le module de classe cela ne fonctionne plus ?
et que je passe la classe avec cette instruction vers le module de classe a partir du module standard
Pays.Item Pays, data(i, 1)

en parémètrant bien cela dans le module de classe :
Private mCLn As New Collection
et
dans le module de classe, consigner cette classe dans la collection qui est incluse dans le module de classe avec
l'instruction ci-dessous
Public Function Item(ByVal NewValue1 As ClsPays, ByVal NewValue2 As String) As Collection
mCLn.Add NewValue1, NewValue2
End Function

c'est une copie d'une seul classe recopier dans la collection ?
avec le code en Poste #34 (Qui Fonctionne pas ?)

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

Pièces jointes

  • Test Module de classe.xlsm
    32.7 KB · Affichages: 4
Dernière édition:

laurent950

XLDnaute Barbatruc
@Dranreb

Avec votre méthode gigogne il y a enormément de chemin avant d'arrivé a cette instruction
L'objet SsGr est aussi muni de quelques méthodes que vous pourriez peut être étudier …
et je me suis perdu dans les chemins, perdu le fils juste avant d'arrivé a cette instruction dont vous parler.
Je voudrais sauter toutes les étapes c'est a dire passé directement a cela :
Dim data As Variant ' ............................................................. 1)
data = Sheets("ModuleDeClasse AvecCollections").ListObjects(1).DataBodyRange.Value2

une fois le tableau récupérer
utilisé votre méthode en simplifiant comme j'essaie de faire dans mes codes (faux certes)
pour réussir a consigné une photocopie d'une classe dans une collection depuis un module de classe.
 

laurent950

XLDnaute Barbatruc
@Dranred

J'ai vraiment essayer de comprendre mais a un moment je me suis perdu dans les chemins.

Par rapport au fichier GigogneLaurent950.xlsm

Ce que je comprend dans l'odre du déroullé de votre procédure.

Depuis le module standard(Module1)
For Each SGrCode In Gigogne(ActiveSheet.ListObjects(1), 1)
Le top départ est donné par cette Fonction Gigogne avec l'envois vers cette fonction en paramétre
- ActiveSheet.ListObjects(1) Le tableau Structuré et un Nombre 1

Maintenant depuis le Module Standard(MGigogne) Qui est le coeur de ce fameux programme Gigogne.
Donc ont arrive Ici
- Function Gigogne(ByVal PlageOuTableau, ParamArray ColOrd() As Variant) As Collection
- PlageOuTableau = Le tableau Structuré, - ColOrd() la variable tableau Optinal de type ParamArray contenant dans une case du tableau 1

Par la suite il y a un test que vous effectué avec cette fonction.
- TableauAcquis TDon, PlageOuTableau, Pour:="Gigogne"

Donc Ont arrive dans cette fonction :
- Function TableauAcquis(TDon(), ByVal Source, ByVal Pour As String) As Boolean
- TDon() se sera le tableau vide a remplir, Source = Le tableau structuré, Puis Pour Une clé qui porte le nom "Gigogne"

Question 1) cette fonction et de type Boolean
- Il y a une logique de passé par cette fonction qui révera Vrai ou Faux ? c'est une logique que vous pouvez Expliqué ?
Car tous de suite au tous dédut vous passé TableauAcquis = True à cette valeur Vrai.

Pour ce qui est du Select Case TypeName(Source)
J'ai bien compris c'est dans le test d'une procédure pour en déterminé la typologie de cette variable (Source)
et determimé sont type : Range/Variant/ListObject/ListColumn/Worksheet/String/Collection/Null/Nothing/Error ou Case Else pour les autres cas non supporté.


En Rapport avec ma question 1) La Valeur False est engagé uniquement Pour Range/Variant.

' ********************************************************************************************************************************************

Ont peux passé la question 1.
Pour notre cas ont rentre dans cette condition Case "ListObject" (car c'est bien un tableau structuré Source)

- Case "ListObject": Set LOt = Source: RécupérerTablo TDon, Nothing, Pour

donc il y a une copie de Source dans cette nouvelle variable Lot de type tableau Structuré Soit : LOt As ListObject

Puis on passe par une autres fonction : RécupérerTablo TDon, Nothing, Pour

- Private Sub RécupérerTablo(TDon(), ByVal Rng As Range, ByVal Pour As String)

Voila comment j'interprete vos paramétres TDon() = Toujours le tableau a remplir
Rgn = Nothing (car précèdement nous ne somme pas rentrer dans la condtion Range du selecte Case)
Pour = qui est toujours une clé qui porte le nom de gigogne


Cette procédure transfert un élément dans un range : Set Rng = LOt.DataBodyRange
Cela j'ai bien compris car cette variable de type Range Rgn doit être remplis est initialisé.
pour transférer les valeur du range Value vers le Tableau TDon
Compris.
est donc Private TDon() est privé a votre Module(MGigogne)

Question 2) Dans cette configuration nous avons pas était dans ce cas () mais j'ai cette question :
Set Rng = Intersect(Rng.EntireColumn, LOt.DataBodyRange)
Ici C'est le numéro de Colonne = Rng.EntireColumn, Est la matrice soit le tableau Structuré = LOt.DataBodyRange)

Pour détailé est expliqué Intersect, c'est pour rechercher est consigné que cerataine colonne de cette Matrice dans Rgn.
Réponse = Vrai Ou Faux c'est autres chaose ?


' ********************************************************************************************************************************************

Ont revient dans la Fonction TableauAcquis est cette fois-ci c'est bon TDon() est remplis.

Question 3 = C'est une fonction alors ou est renvoyé Vrai Ou Faux ?

Function TableauAcquis(TDon(), ByVal Source, ByVal Pour As String) As Boolean
[ °°° Code °°° ]
[ °°° Code °°° ]
[ °°° Code °°° ]
TableauAcquis =
End Function

Puisque l'on entre que dans cette condition
Case "ListObject": Set LOt = Source: RécupérerTablo TDon, Nothing, Pour
et que l'ont sort du select Case
Alors cela devrait Renvoyer TableauAcquis = True

J'imaginais cela :
Case "ListObject": Set LOt = Source: RécupérerTablo TDon, Nothing, Pour : TableauAcquis = True

et que cela pourrais servir par la suite d'ou Ma question 1 et 3 ?

' ********************************************************************************************************************************************

de retour dans la Fonction Gigogne

- Function Gigogne(ByVal PlageOuTableau, ParamArray ColOrd() As Variant) As Collection

Ligne : If UBound(ColOrd) >= LBound(ColOrd) Then InterpréterParam ColOrd, UBound(TDon, 2), Pour:="Gigogne"

Ici je conceptualise le 1 qui se trouve dans la case du tableau ColOrd
est cela UBound(ColOrd) >= LBound(ColOrd) ?
Il y a un cas ou UBound(ColOrd) est moins grand que LBound(ColOrd) ?
Forcément vous l'avez déjà eu pour faire ce test


Puis Maintenant que la condition est vrai alors on retourne dans une autre fonction :

- InterpréterParam ColOrd, UBound(TDon, 2), Pour:="Gigogne"

Que j'interprete comme cela :
Private Sub InterpréterParam(ByVal ColOrd As Variant, ByVal UBnd2 As Long, ByVal Pour As String)
c'est le fameux tableau Optional ParamArray qui contient le 1 dans une seule case pour ColOrd.
Derniére colonne du Tableau TDon soit 3 Colonnes en Tous
Puis Pour Une clé qui porte le nom "Gigogne"


Et de nouveau nous somme renvoyer vers une fonction :


Question 4)
Que je ne sais pas interprétè :

Call RàZArguments
Sub RàZArguments(Optional ByVal LstObj As ListObject = Nothing)

vous renvoyer le Tableau Structuré LstObj et vous en derterminé un argument facultatif avec Nothing.

Je sais pas lire cette ligne de code
Optional ByVal LstObj As ListObject = Nothing
(Optional) = OK
(ByVal) = OK vous m'avez déjà expliqué par le passé
(LstObj As ListObject) = OK
( = Nothing) = La je ne sais pas l'interprétè ?

Je sais pas lire cette fonction

ici
(ArgMax = 0) = OK : (RupMax = &H7FFFFFFF) = Je sais vraiment pas : (Erase TCols, TSens) = OK
(If Not LstObj Is Nothing Then Set LOt = LstObj) = OK



Puis retour dans la fonction
Private Sub InterpréterParam(ByVal ColOrd As Variant, ByVal UBnd2 As Long, ByVal Pour As String)

Ligne (For P = LBound(ColOrd) To UBound(ColOrd)) = OK

puis sur cette ligne

IsArray(ColOrd(P)) ' n'est pas une variable tableau mais ColOrd est une variable de Type ParamArray ?

Alors (Else)

Ont repart vers une Fonction

AjoutArgument ColOrd(P), UBnd2, Pour


que j'interpréte comme cela :
Sub AjoutArgument(ByVal ColOrd1 As Variant, Optional ByVal UBnd2 As Long = &H7FFFFFFF, Optional ByVal Pour As String = "AjoutArgument")
ColOrd1 = Variable de type ParamArray
Enfin j'ai compris si les deux varibla si dessous sont envoyé Vide Alors pas défaut
Optional ByVal UBnd2 As Long = &H7FFFFFFF | Derniére case du tableau TDon mais si vide Pourquoi y affecté cela &H7FFFFFFF
Optional ByVal Pour As String = "AjoutArgument" | C'est toujour la clé Pour Gigogne mais si vide Pourquoi y affecté cela "AjoutArgument"

et la dans le select Case puisque UBnd2 est une variable de type Long
Case vbLong, vbInteger, vbByte, vbDouble: Col = Abs(ColOrd1): Sens = Sgn(ColOrd1)
If Col > UBnd2 Then MsgBox "Argument " & ArgMax + 1 & ": " & IIf(Sens < 0, "-", "+") & Col & vbLf _
& "Numéro de colonne " & Col & " > " & UBnd2 & " maxi des données.", vbCritical, Pour: End

J'ai su lire cela : Col = Abs(ColOrd1): Sens = Sgn(ColOrd1)
Mais sans l'idée d'un concepte enfin vaguement, si c'est des chiffres non entier ? pour l'arborescence ?

(ArgMax = ArgMax + 1) = OK car une variable tableau pour etre compatible avec Excel la faire commencé a la Valeur 1

La j'ai pas trop compris l'interet aussi enfin pas su conceptualisé le sens
ReDim Preserve TCols(1 To ArgMax), TSens(1 To ArgMax): TCols(ArgMax) = Col: TSens(ArgMax) = Sens
mais je sais lire le code, c'est le sens que je sais pas immaginé ?

De retour dans la fonction
Private Sub RécupérerTablo(TDon(), ByVal Rng As Range, ByVal Pour As String)

Ligne If RupMax > ArgMax Then RupMax = ArgMax

question 5 ) qu'elle est la raison de mette une très grande valeur a RupMax ? c
Il y a une astuce, laquelle ?



Puis retour dans la Function Gigogne(ByVal PlageOuTableau, ParamArray ColOrd() As Variant) As Collection

ligne = IndexerParFusions TbIdx, TDon

une autre fonction

Sub IndexerParFusions(TIdx() As Long, TDon(), ParamArray ColOrd() As Variant)

Il est super complexe, le macanisme est lourd a saisir ?

maintenant j'ai compris cela If UBound(ColOrd) >= LBound(ColOrd) avec le code quand j'avance car UBound(ColOrd) = -1 | OK

tous est imbriqué

Par exemple cela ReDim TIdx(1 To &HFFF&)
comment cela vous ai venu a l'idée de choisir cette valeur avec cela &HFFF& c'est arbitraire ou c'est la limite Max = a cette valeur
C'est du moins astucieux si c'est le cas


je me suis arreté ici.
 

Dranreb

XLDnaute Barbatruc
Il y a un cas ou j'ai besoin de savoir si l'acquisition a été nécessaire, je ne sais plus bien où.
Il y a un cas ou UBound(ColOrd) est moins grand que LBound(ColOrd) ?
Oui: quand rien n'est précisé du tout c'est (0 To -1). Les colonnes peuvent avoir déjà été précisées dans une autre procédure du module.

Disons que la dimension initiale de TIdx à été choisie en fonction de la façon dont je l'agrandis plus loin, par Redim Preserve, par paquets mais plus petits, si ça ne suffit pas, aussi toujours avec une dimension maxi finissant par quelques bits à 1.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Bonjour
Après enquête, c'est dans un module auxiliaire supplémentaire que j'ai :
VB:
If TableauAcquis(TSrc, TP(P), Pour:="TableUnique") Then TP(P) = TSrc
TP y est un ParamArray d'une procédure appelante retransmis en tant que tableau normal.
Ça vérifie en somme que TP(P) n'est pas déjà un tableau acquis avant de l'y changer en tant que tel.
Partout ailleurs la Function TableauAcquis est utilisée comme une Sub sans s'intéresser au Boolean renvoyé.
 

Dranreb

XLDnaute Barbatruc
Sens est le sens de classement souhaité 1: croissant, -1: décroissant.
Sont acceptés aussi les noms de ListColumn éventuellement précédés de "-" ou "+". Pour tout autre 1er caractère, "+" est assumé, mais il serait à préciser obligatoirement si jamais l'intitulé concerné devait lui même commencer par "+" ou "-"
C'est pour ça que ça s'appelle ColOrd : Colonne avec Ordre de classement.
Ce Sens est appliqué par la Function VarComp utilisée par l'IndexerParFusions dans une séquence en fin invoquée par GoSub Comparer
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Une chose importante, qui manque toujours dans vos essais perso, est à observer dans ma Private Function SousGroupes :
Elle renvoie une Collection et tout SsGr qu'elle crée y est toujours ajouté, avec ou sans clé.
L'instruction qui l'ajoute est toujours la même, qu'on soit dans un niveau contenant d'autres SsGr, dans un mode spécial où on ne s'intéresse qu'aux numéros de lignes des données, où dans l'établissement normal des lignes de détail :
Code:
If VarType(SsGr.Id) = vbString Then SousGroupes.Add SsGr, Key:=SsGr.Id Else SousGroupes.Add SsGr
Bien sûr, lorsque le SsGr courant devra en contenir d'autres elle affecte à son Co la collection renvoyée par son appel récursif pour le niveau suivant, qui aura fait de même, sans jamais oublier, donc, de ranger quelque part un exemplaire créé, afin qu'il soit conservé.
 
Dernière édition:

dysorthographie

XLDnaute Accro
Bonjour,
J'ai commencé à lire tous les postes mais j'ai craqué car je ne comprends absolument rien.

Je pense m'y connaitre un peu en module de classe associée à des collections.

Peut tu expliquer ce que tu souhaites obtenir.

Pour les exemple de code c'est pas utile tu en as mis déjà et je ne les comprends pas😰
 

Discussions similaires

Statistiques des forums

Discussions
315 087
Messages
2 116 082
Membres
112 654
dernier inscrit
SADIKA