[vba excel] afficher collection dans label

Résolu
andy_kaufmann Messages postés 36 Date d'inscription   Statut Membre Dernière intervention   -  
andy_kaufmann Messages postés 36 Date d'inscription   Statut Membre Dernière intervention   -
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

A voir également:

2 réponses

Réponse 1 / 2
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
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
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
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 ! ;¤)
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Pijaku, excuses moi d'intervenir sur tes propositions ce matin ! ;¤)
T'inquiète, j'en profites également.
continue!!
A+
0
Réponse 2 / 2
andy_kaufmann Messages postés 36 Date d'inscription   Statut Membre Dernière intervention   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
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
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 ?
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
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
0
andy_kaufmann Messages postés 36 Date d'inscription   Statut Membre Dernière intervention   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
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
cf ma réponse juste au dessus...
0
andy_kaufmann Messages postés 36 Date d'inscription   Statut Membre Dernière intervention   6
 
C'est nickel, ça fonctionne parfaitement.

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