[vba excel] afficher collection dans label [Résolu/Fermé]

Signaler
Messages postés
72
Date d'inscription
vendredi 3 août 2007
Statut
Membre
Dernière intervention
27 mars 2013
-
Messages postés
72
Date d'inscription
vendredi 3 août 2007
Statut
Membre
Dernière intervention
27 mars 2013
-
Bonjour,

Je travaille sur un petit programme de gestion. Dans un volet, l'utilisateur doit entrer des jours, qui sont déterminés par 2 caractéristiques, date et évènement. Je veux qu'il entre la paire, puis clique sur un bouton pour ajouter le jour à une liste (collection). Ensuite les champs sont réinisialisés, et la collection entière est affichée dans un label. J'ai écrit ça comme code :

Dim liste_jour As New Collection

Worksheets("events").Range("a1").Select
Do Until ActiveCell = ""
    ActiveCell.Offset(1, 0).Select        
Loop

ActiveCell.FormulaR1C1 = dateF
ActiveCell.Offset(0, 1).Range("a1").Select
ActiveCell.FormulaR1C1 = txtEvent
ActiveCell.Offset(0, 1).Range("a1").Select

entree = dateF & ", " & txtEvent
ActiveCell.FormulaR1C1 = entree

liste_jour.Add Item:=entree

lbl_liste_jour.Caption = liste_jour


lbl_liste_jour étant le label sur mon userform dans lequel je veux afficher la collection.

Et y a-t-il un moyen simple pour vérifier si une collection contient déjà un objet ? Je pensais une fonction du type member ou contain, mais j'ai rien trouvé dans l'aide. La seule façon c'est de faire une espèce de boucle ou je compare les nom des éléments déjà intégrés. Je suis sur qu'il existe un moyen plus simple....

Merci pour vos conseils !!

andy

2 réponses

Messages postés
12272
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
14 mai 2020
2 422
Bonjour,
Une méthode pour éviter les doublons : l'ajout d'une clé (paramètre "Key" de l'objet collection).
Dim liste_jour As New Collection
'bla bla bla ton code ici
liste_jour.Add entree, entree 'correspond à : Item:=entree, Key:=entree
La clé doit être unique, sinon provoque une erreur. Le code donné ci-dessus plante en effet dès que l'on rencontre un doublon.
Il nous faut donc gérer l'erreur provoquée par ce doublon. Pour cela, on active le gestionnaire d'erreur et on traite celle-ci comme ceci :

Dim liste_jour As New Collection
On Error Resume Next
'bla bla bla ton code ici
liste_jour.Add entree, entree 
On Error GoTo 0

Ensuite, pour compléter le caption de ton label, il convient de boucler sur tous les éléments de ta collection :
Dim Liste As String 'ou autre type
Dim Cpt As Integer
For Cpt = 1 To coll.Count
    Liste = Liste & liste_jour(Cpt)
Next
lbl_liste_jour.Caption = Liste
2
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 84957 internautes nous ont dit merci ce mois-ci

Messages postés
16192
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
13 mai 2020
2 955
Bonjour Andy, Pijaku

Si vous utilisez une collection, il faut absolument la vider à la fin de la macro car elle a été instanciée par un " dim as...new"

set lacollection=nothing

d'autre l'objet "dictionnary" est plus efficace car n'utilisant pas le gestionnaire d'erreur

proposition

Sub labeliser() 
Dim liste_jour As Object 
Dim fin As Long, cptr As Long, entree As String 
Dim tablo 

'initialisations 
 With Worksheets("events") 
 'With Sheets(1) 'maquette 
     fin = .Columns("A").Cells(.Cells.Rows.Count, "A").End(xlUp).Row 
     tablo = .Range("A1:B" & fin).Value 
     Set liste_jour = CreateObject("scripting.dictionary") 
     'collecte sans doublons 
     For cptr = 1 To UBound(tablo) 
          entree = tablo(cptr, 1) & "," & tablo(cptr, 2) 
          If Not liste_jour.exists(entree) Then liste_jour.Add entree, "x" 
     Next 
     restitutions 
     lbl_liste_jour.Caption = Join(liste_cours.keys, " ; ") 
     '.Range("D2") = Join(liste_jour.keys, " ; ") 'maquette 
End With 
End Sub


Pijaku, excuses moi d'intervenir sur tes propositions ce matin ! ;¤)
Messages postés
12272
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
14 mai 2020
2 422
Pijaku, excuses moi d'intervenir sur tes propositions ce matin ! ;¤)
T'inquiète, j'en profites également.
continue!!
A+
Messages postés
72
Date d'inscription
vendredi 3 août 2007
Statut
Membre
Dernière intervention
27 mars 2013
6
Bonjour,

merci pour ces réponses, ça marche à merveille !!!

petite question supplémentaire, les items qui sont affichées dans mon label sont tous à la suite sur la même ligne. y a-t-il un moyen pour faire que chaque item commence sur une nouvelle ligne ?

Merci pour vos réponses

andy
Messages postés
16192
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
13 mai 2020
2 955
Bonjour,
8 jours, ton appli semble ni urgente ni importante...

Sans réponse de ta part, la maquette a été détruite.... on fait des efforts pour répondre rapidement pour soulager le demandeur... pour ma part je n'ai pas envie de refaire une maquette pour te proposer un code fonctionnant correctement surtout que tu ne précises pas sur quelle solution tu désires bosser -apparemment c'est celle de Pijaku

A dans 15 jours ?
Messages postés
12272
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
14 mai 2020
2 422
Bonjour,
Lorsque l'on poste un sujet ici, il convient de bien réfléchir à ce que l'on veux au final, et de l'exprimer clairement.
Tu demandes : la collection entière est affichée dans un label, nos deux réponses sont clairement dans ce sens.
Tu ajoutes une remarque, une semaine trop tard, nous ne pouvons effectivement pas garder indéfiniment les fichiers que nous créons pour vous aider...

Mais bon, ta demande est compréhensible.
Alors, sans tester, voici une petite modif (en gras) du code de Michel :
Sub labeliser() 
Dim liste_jour As Object 
Dim fin As Long, cptr As Long, entree As String 
Dim tablo 

'initialisations 
 With Worksheets("events") 
 'With Sheets(1) 'maquette 
     fin = .Columns("A").Cells(.Cells.Rows.Count, "A").End(xlUp).Row 
     tablo = .Range("A1:B" & fin).Value 
     Set liste_jour = CreateObject("scripting.dictionary") 
     'collecte sans doublons 
     For cptr = 1 To UBound(tablo) 
          entree = tablo(cptr, 1) & "," & tablo(cptr, 2) 
          If Not liste_jour.exists(entree) Then liste_jour.Add entree, "x" 
     Next 
     restitutions 
     lbl_liste_jour.Caption = Join(liste_jour.keys, " ; " & Chr(10))    
     '.Range("D2") = Join(liste_jour.keys, " ; ") 'maquette 
End With 
End Sub
Messages postés
72
Date d'inscription
vendredi 3 août 2007
Statut
Membre
Dernière intervention
27 mars 2013
6
Bonjour michel_m

non, en effet mon appli n'est ni urgente ni importante. je le fais pour mon plaisir à coté de mes heures de travail, un projet professionnel en effet mais que je fais sur ma propre initiative. et je cherche simplement à profiter de la connaissance des autres utilisateurs du forum, notamment de la tienne. tu m'as déjà donné des conseils utiles sur beaucoup de sujets, et je t'en remercie. Toutefois, rien ne t'y oblige.
Maintenant, si tu veux bien continuer, je t'en serai reconnaissant. si tu n'as pas le temps, ben dommage, j'espère qu'une autre personne pourra alors m'aider.

Cela dit, pour la partie du code ci-dessus, je suis parti sur ta solution.
Je vais essayer de répondre avant le 1.10.

Bonne journée
Messages postés
12272
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
14 mai 2020
2 422
cf ma réponse juste au dessus...
Messages postés
72
Date d'inscription
vendredi 3 août 2007
Statut
Membre
Dernière intervention
27 mars 2013
6
C'est nickel, ça fonctionne parfaitement.

Merci pour vos réponses, à bientôt.