Mon premier combobox : selection de la liste

**dodo28** · 28/04/2009, 20h35

bonsoir

je voudrais creer mon premier combobox. Il servira a effectuer une recherche dans une liste. Voila ma premiere macro pour deja remplir une liste deroulante pour effectuer mon choix, et bien sur ca ne marche pas. Merci pour votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Private Sub ParMassif()
 
Dim cell As Range
Dim ParMassif As MSForms.ComboBox
 
 
 
'Boucle sur les cellules de la plage A2:A1870 pour
'alimenter le ComboBox
For Each cell In Sheet("Liste").Range("A2:A1870")
    Liste.ParMassif = cell
    'remplissage sans doublon
    If Sheet("Liste").ParMassif.ListIndex = -1 Then _
        Sheet("Liste").ParMassif.AddItem cell
Next cell
 
End Sub

**casefayere** · 28/04/2009, 21h51

Bonsoir,
Ou est situé ton combobox,

Dans un UF ?, c'est un controle activex directement sur la feuille?
après, on verra

a +

**dodo28** · 28/04/2009, 22h11

bonsoir il est dans un userform

**casefayere** · 28/04/2009, 22h51

Bon, ajoutes dans l'evenement initialise de ton UF, ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
With Sheets("liste")
Dim x As Integer, plage As Range, nl As Integer, d as integer
nl = .Range("A" & .Rows.Count).End(xlUp).Row
'Boucle sur les cellules de la plage A2:A1870 pour
'alimenter le ComboBox
ParMassif.Clear
For x = 2 To nl
Set plage = .Range("a" & x + 1, "a" & nl)
 
    'remplissage sans doublon
    d = Application.WorksheetFunction.CountIf(plage, .Range("a" & x))
    If d = 0 Then
    ParMassif.AddItem .Range("a" & x)
    End If
Next x
End With

ça devrait fonctionner

**dodo28** · 28/04/2009, 23h12

Merci beaucoup ca marche
Dans mon UF j ai 3 combobox, si j ai bien compris je fais pareil pour les 2 autres en empilant dans le même code que le précédent en ajoutant des With et end with?

**casefayere** · 28/04/2009, 23h20

j'ai fait une erreur à la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set plage = .Range("a" & x + 1, "a" & nl)

il faut l'écrire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set plage = .Range("a" & x + 1, "a" & nl + 1)

sinon ta derniere ligne n'apparaitra pas dans le combobox

pour les autres combobox, je ne sais pas car je ne connais pas ton fichier, essayes

tu as compris with et end with ?,
C'est simplement pour éviter de réecrire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

sheets("liste")

à chaque fois

**dodo28** · 29/04/2009, 12h41

Bonjour
Merci beaucoup pour ton travail c'est super et je commence a comprendre (j'ai dit "commence"

).
Maintenant selon la selection dans les comboboxs, il va se passer differentes choses, peux tu m orienter?
Si oui je t explique mon objectif et te joins le fichier.

Mon fichier excel comporte 2 feuilles : Visio et Liste.
Dans la feuille liste : tu as une liste de données gérées par massif (A01,A02, B01,J10..etc (82 massifs differents) dans ces massifs tu as differents noms (jean Dupont, Dominique Durand, etc).
Chaque nom est identifié par un matricule de 6 chiffres en format texte (001204, 245632, 012548, etc..).
Un meme nom peut se trouver plusieurs fois dans le meme massif ou dans differents massifs mais il portera un matricule different.

Dans la feuille Visio : elle permet de visionner l'ensemble du contenu d'un massif. par exemple quand tu rentres B02 (nom du massif) dans la cellule f01 et tu clic sur le bouton avec photo chevreuil, il apparait dans cette feuille toutes les lignes concernées par le massif Bo2 avec les calculs necessaire.

Maintenant les combobox de recherche va me servir à visionner un massifs (dans visio) selon 3 criteres :

1. Recherche par massifs (surement le plus simple), il faut quand je selectionne un massif dans le combobox "Par massif", il faut que le code renvoie la selection dans la cellule F01 et applique la macro correspondant au bouton "chevreuil". Et dans les 2 autres combobox (par nom et par matricule) me presente un choix uniquement de ce massif.
2. recherche par code(matricule), il faut quand je selectionne un matricule il faut que la macro selectionne le massif correspondant au matricule et fasse apparaitre le massif dans la feuille visio et surligne la ligne du matricule selectionné en vert.
3.recherche par nom (plus compliqué), il faut quand je selectionne un nom il faut que la macro selectionne le massif correspondant au nom et fasse apparaitre le massif dans la feuille visio et surligne la ligne du nom selectionné en vert. Et comme je peux avoir le meme nom dans plusiuers massifs ou dans le meme massif, il faut que les combobox par massifs et par code me donne un choix a effectué.

Voila, j espere que j'ai été assez explicite. je joins mon fichier. merci

**dodo28** · 29/04/2009, 21h17

bon j ai reussi a faire la selection par massif en réalisant ce code certes un peu lent pour l apparition de l userform.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Private Sub Valider_Click()
 
 'Blocage ecran
Application.ScreenUpdating = False
 
'suppression de la selection dans visio
Range("A15:AH65536").EntireRow.Delete
'selection de liste
Sheets("Liste").Activate
'active les filtres
 Sheets("Liste").Range("$A$1:$Ah$18").AutoFilter Field:=1, Criteria1:=ParMassif
Range("a2:ah" & Range("a65536").End(xlUp).Row).Copy Destination:=Sheets("Visio").Range("a15")
'Selection.AutoFilter Field:=1
 
'retire le quadrillage
ActiveWindow.DisplayGridlines = False
'feuille visio
Sheets("Visio").Activate
'enlevefiltre sur e01:m01
 
    Range("E1:M2").Select
    Selection.AutoFilter
    'format date
   Range("Tableau2[Date demande]").Select
    Selection.NumberFormat = "dd/mm/yy;@"
 'selection de f01
    Range("f01").Select
 'Dé-Blocage ecran
Application.ScreenUpdating = True
 
End Sub

Maintenant je voudrais effectuer la sélection par code(matricule) pour cela le critère (criterial1) de filtre est = ParCode - 2 cellules à gauche. 2 cellules a gauche se trouve le nom du massif.
Quelqu'un peu m aider? merci

**casefayere** · 29/04/2009, 22h36

Bonsoir Dodo, le forum,
Comme je n'ai pas trop le temps, pour l'instant, je me permets de reprendre ton code, en le disséquant :
Private Sub Valider_Click()
là, ok

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 'Blocage ecran
Application.ScreenUpdating = False

là, tu ne dis pas si les cellules doivent etre décalées vers la droite, vers le haut..., mais ce n'est peut-etre pas important

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'suppression de la selection dans visio
Range("A15:AH65536").EntireRow.Delete

là, tu as-tu vraiment besoin de voir ta feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'selection de liste
Sheets("Liste").Activate

sinon, tu supprimes la partie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'active les filtres
 Sheets("Liste").Range("$A$1:$Ah$18").AutoFilter Field:=1, Criteria1:=ParMassif

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Sheets("Liste").Range("a2:ah" & Range("a65536").End(xlUp).Row).Copy Destination:=Sheets("Visio").Range("a15")
'Selection.AutoFilter Field:=1

ci-dessous, je ne connais pas le besoin de supprimer le quadrillage, mais toi, tu dois savoir

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'retire le quadrillage
ActiveWindow.DisplayGridlines = False

là tu peut supprimer le "activate"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'feuille visio
Sheets("Visio").Activate 'à supprimer

'enlevefiltre sur e01:m01
ci-dessous, je te conseille de changer le code à selection autofilter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
  Sheets("Visio").Range("E1:M2").Select
    if Selection.AutoFilter = true then
    selection.autofilter = false
    end if

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'format date
       Range("Tableau2[Date demande]").NumberFormat = "dd/mm/yy;@"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 'selection de f01
    Range("f01").Select
 'Dé-Blocage ecran
Application.ScreenUpdating = True 
End Sub

bon j ai reussi a faire la selection par massif en réalisant ce code certes un peu lent pour l apparition de l userform.

Par contre, je ne vois pas où ton UF apparait

**dodo28** · 29/04/2009, 23h23

merci pour ton aide mais a chaque fois que je modifie quelques choses ca plante et même a un moment ça a supprimer toutes ma feuilles liste, oups
Je te rejoins mon fichier et pour appeler le userform il faut cliquer sur le bouton recherche en visio.

**casefayere** · 29/04/2009, 23h40

re,

je viens d'ouvrir ton fichier,

Alors expliquoe-moi. J'ouvre l'UF, si je selectionne un nom dans la combo par_nom, tu veux voir apparaitre tous les massifs correspondant au nom, c'est ça ? ainsi que tous les codes ?

je ne suis pas forestier pour 2 ronds meme si j'aime la nature, et ton tableau, je ne le comprends pas

**dodo28** · 30/04/2009, 00h18

Pas tout a fait forestier mais pas loin , je suis technicien de la gestion de la faune sauvage et de ses habitats. Si tu as des question sur ce sujet je m y ferai un grand plaisir. revenons a nos moutons, heu...non a nos chevreuils.

Dans liste, il y a une colonne massifs(colonne A), chaque massif correspond a un ensemble de propriétaire. Dans un massif forestier, il y a plusieurs propriétaires. Un propriétaire est identifié par un matricule (colonne c). Le but quand j appelle un propriétaire tous les propriétaires du même massifs apparaissent dans visio.
pour appeler un massif dans visio, il y a donc 3 solutions :
- je sélectionne le nom du massif dans par massifs, exemple je sélectionne le massif A03, tous les propriétaires du massif A03 arrivent dans la feuille visio.
- je sélectionne par matricule, exemple je sélectionne le matricule 043001, le matricule correspond à un propriétaire Porcher Lucette qui est propriétaire dans le massif B05 alors toutes les lignes ayant le massifs B05 doit apparaitre dans visio
- Je sélectionne par nom, je recherche Porcher Lucette qui est propriétaire dans le B05 alors le B05 doit apparaitre dans visio.
Pour comprendre, il faut imaginer que madame Porcher Lucette m'appele au telephone. elle me demande une question sur son massifs, par exemple combien il y a de propriétaire sur son massif? mais madame porcher ne se souvient plus du nom de son massif ni de son matricule.
Alors je tape porcher lucette sur UF et toutes les données du massif arrivent dans la feuille visio.
la même chose si elle a oublié son nom(

) et ne connais que son matricule (ha!La pauvre lucette). Je tape son matricule est le massif b05 arrive dans visio.
Voila j espere que c'est pas trop penible. merci

**casefayere** · 30/04/2009, 10h31

Bonjour le forum, dodo28,

Ci-dessous une partie de code qui ne s'occupe pas des filtres mais des entrées en combobox

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Private Sub Valider_Click()
Dim x As Integer, y As Integer
Application.ScreenUpdating = False
'suppression de la selection dans visio
Sheets("visio").Range("A15:Ah65536").EntireRow.Clear
With Sheets("liste")
If ParMassif <> "" Then
    y = 15
    For x = 2 To .Range("a" & .Rows.Count).End(xlUp).Row
        If .Range("a" & x).Value = ParMassif Then
        Sheets("visio").Range("a" & y).EntireRow.Value = .Range("a" & x).EntireRow.Value
        y = y + 1
        End If
    Next x
End If
If ParNom <> "" Then
    y = 15
    For x = 2 To .Range("a" & .Rows.Count).End(xlUp).Row
        If .Range("d" & x).Value = ParNom Then
        Sheets("visio").Range("a" & y).EntireRow.Value = .Range("a" & x).EntireRow.Value
        y = y + 1
        End If
    Next x
End If
If ParCode <> "" Then
    y = 15
    For x = 2 To .Range("a" & .Rows.Count).End(xlUp).Row
        If .Range("d" & x).Value = ParCode Then
        Sheets("visio").Range("a" & y).EntireRow.Value = .Range("a" & x).EntireRow.Value
        y = y + 1
        End If
    Next x
End If
End With
Application.ScreenUpdating = True

je n'ai pas regardé ce qui suivait, pour l'instant, regardes ce bout de code et dis-moi quoi, c'est sur qu'il sera à améliorer

Bonne journée à tous

**dodo28** · 30/04/2009, 11h52

Bonjour Casefayer et le forum,

Merci pour ton travail, c'est vraiment sympa. Alors je viens d'essayer ton code. Aprés avoir modifier le"d" en "c" dans la partie suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
if ParCode <> "" Then
    y = 15
    For x = 2 To .Range("a" & .Rows.Count).End(xlUp).Row
        If .Range("c" & x).Value = ParCode Then
        Sheets("visio").Range("a" & y).EntireRow.Value = .Range("a" & x).EntireRow.Value
        y = y + 1
        End If
    Next x
End If

Quand je fais une recherche par massif, pas de probleme ca marche. Tout le massif apparait dans visio.

Quand je fais une recherche par code, juste la personne concernée par ce code apparait et il faudrait que ce soit tout le massif du code concernée.
Exemple le code 096002 doit faire apparaitre dans la feuille visio tout le massif A01.
Pareil pour la recherche par Nom.
je crois qu'il faudrait penser comme ceci:
si range("c"& x).value =ParCode alors regarder 2 cellules a gauche (nom du massif) puis selectionner toutes les lignes de la feuille "liste" correspondant a cette valeur.
Merci

**casefayere** · 30/04/2009, 12h33

essaye ceci, en ajoutant une variable

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

nommassif as range

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
If ParCode <> "" Then
Set nomMassif = .Range("c2:c" & nl).Find(ParCode)
    y = 15
    For x = 2 To .Range("a" & .Rows.Count).End(xlUp).Row
        If .Range("a" & x).Value = nomMassif.Offset(0, -2).Value Then
        Sheets("visio").Range("a" & y).EntireRow.Value = .Range("a" & x).EntireRow.Value
        y = y + 1
        End If
    Next x
End If

**casefayere** · 01/05/2009, 02h00

comme je ne dors pas encore,

Je trouve ton USF assez long à s'initialiser, alors j'ai cherché une autre méthode pour alimenter tes listbox sans doublons, j'ai trouvé mais c'est toujours aussi long, sinon plus, la différence est que tout est trié dans les listbox par ordre alphabétique.

C'est un code proposé par ouskel'n'or (merci ouskel'n'or), en janvier 2009.
http://www.developpez.net/forums/d51...lable-methode/

t'en feras ce que tu en veux :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Private Sub UserForm_Initialize()
Dim Tablo As Variant, Tempo As Variant, i As Long, j As Long
With Sheets("Liste")
    .Activate 'à défaut d'instancier la feuille
    Tablo = Range("a2:a" & Range("a" & Rows.Count).End(xlUp).Row).Value
'triAlpha
    For i = 1 To UBound(Tablo)
        For j = 1 To UBound(Tablo)
            If Tablo(i, 1) < Tablo(j, 1) Then
                Tempo = Tablo(i, 1)
                Tablo(i, 1) = Tablo(j, 1)
                Tablo(j, 1) = Tempo
            End If
        Next j
    Next i
'Remplissage excluant les doublons
    ParMassif.AddItem Tablo(1, 1)
    For i = 2 To UBound(Tablo)
        If Tablo(i, 1) <> Tablo(i - 1, 1) Then ParMassif.AddItem Tablo(i, 1)
    Next
'-------------------------------------------------------------------------------------------------
Tablo = Range("c2:c" & Range("a" & Rows.Count).End(xlUp).Row).Value
'triAlpha
    For i = 1 To UBound(Tablo)
        For j = 1 To UBound(Tablo)
            If Tablo(i, 1) < Tablo(j, 1) Then
                Tempo = Tablo(i, 1)
                Tablo(i, 1) = Tablo(j, 1)
                Tablo(j, 1) = Tempo
            End If
        Next j
    Next i
'Remplissage excluant les doublons
    ParCode.AddItem Tablo(1, 1)
    For i = 2 To UBound(Tablo)
        If Tablo(i, 1) <> Tablo(i - 1, 1) Then ParCode.AddItem Tablo(i, 1)
    Next
'-------------------------------------------------------------------------------------------------
Tablo = Range("d2:d" & Range("a" & Rows.Count).End(xlUp).Row).Value
'triAlpha
    For i = 1 To UBound(Tablo)
        For j = 1 To UBound(Tablo)
            If Tablo(i, 1) < Tablo(j, 1) Then
                Tempo = Tablo(i, 1)
                Tablo(i, 1) = Tablo(j, 1)
                Tablo(j, 1) = Tempo
            End If
        Next j
    Next i
'Remplissage excluant les doublons
    ParNom.AddItem Tablo(1, 1)
    For i = 2 To UBound(Tablo)
        If Tablo(i, 1) <> Tablo(i - 1, 1) Then ParNom.AddItem Tablo(i, 1)
    Next
End With
End Sub

et comme je ne dors toujours pas, une autre méthode

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub UserForm_Initialize()
 
With Sheets("Liste")
 
Set mas = CreateObject("Scripting.Dictionary")
For Each c In Range([A2], [A65000].End(xlUp))
If Not mas.Exists(c.Value) Then mas.Add c.Value, c.Value
ParMassif.List = mas.items
Next c
Set cod = CreateObject("Scripting.Dictionary")
For Each c In Range([c2], [c65000].End(xlUp))
If Not cod.Exists(c.Value) Then cod.Add c.Value, c.Value
ParCode.List = cod.items
Next c
Set pnom = CreateObject("Scripting.Dictionary")
For Each c In Range([d2], [d65000].End(xlUp))
If Not pnom.Exists(c.Value) Then pnom.Add c.Value, c.Value
ParNom.List = pnom.items
Next c
End With
End Sub

c'était le dernier, le marchand de sable est passé

**dodo28** · 02/05/2009, 12h56

Bonjour casefayere et le forum,
je viens de me repencher sur tes propositions, c'est vrai que l'initialisation est longue, mais j'ai remarquer que lorsque le pc est redémarré l'initialisation est plus rapide donc je pense que le problème viens de la mémoire utilisée pour cette initialisation. Ne serait t il pas judicieux de purger les mémoires après chaque utilisation? l Uf met dans la liste 1800 matricules, 1800 noms et 85 massifs.
Ensuite pour le coloriage de la ligne, je croyais au début que cela ne marchais pas et après plusieurs essais je me suis aperçu que DE TEMPS en TEMPS cela colorié mais pas tout le temps. Çà c'est bizarre.

**casefayere** · 02/05/2009, 13h18

Bonjour Dodo,

Je suis etonné par cette histoire de couleur, attention je ne l'ai fait que pour parnom, à toi de répéter la meme procédure pour matricule

Pour la mémoire, je ne sais pas, il faudrait voir plus loin, d'autant que les propositions que je t'ai faites n'accélèrent pas vraiment l'initialisation

tiens-moi au courant

Bon Weed-end

**dodo28** · 02/05/2009, 13h44

Tu vois quand je fais une recherche par nom pour Lenormand ca marche (coloriage) , une recherche pour Tonnelier ca ne marche pas.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Private Sub Valider_Click()
 
Dim x As Integer, y As Integer
Dim nomMassif As Range
Dim nomMassif1 As Range
Dim nl As Integer
 
'Bloque l'ecran
Application.ScreenUpdating = False
 
'suppression de la selection dans visio
Sheets("visio").Range("A15:Ah65536").EntireRow.Clear
 
With Sheets("liste")
nl = .Range("A" & .Rows.Count).End(xlUp).Row
 
'selection par Massif
If ParMassif <> "" Then
    y = 15
    For x = 2 To .Range("a" & .Rows.Count).End(xlUp).Row
        If .Range("a" & x).Value = ParMassif Then
        Sheets("visio").Range("a" & y).EntireRow.Value = .Range("a" & x).EntireRow.Value
        y = y + 1
        End If
    Next x
End If
 
'selection du massif par le nom
If ParNom <> "" Then
Set nomMassif1 = .Range("d2:d" & nl).Find(ParNom)
    y = 15
    For x = 2 To .Range("a" & .Rows.Count).End(xlUp).Row
        If .Range("a" & x).Value = nomMassif1.Offset(0, -3).Value Then
        Sheets("visio").Range("a" & y).EntireRow.Value = .Range("a" & x).EntireRow.Value
        y = y + 1
        End If
        If Sheets("visio").Range("d" & x).Value = nomMassif1.Value Then
        Sheets("visio").Range("a" & x, "ah" & x).Interior.ColorIndex = 43
        End If
 
    Next x
End If

**casefayere** · 02/05/2009, 14h28

salut Dodo,
j'ai ajouté une variable

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

nlvisio as integer

Change la partie de code comme ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
If ParNom <> "" Then
Set nomMassif1 = .Range("d2:d" & nl).Find(ParNom)
    y = 15
    For x = 2 To nl
        If .Range("a" & x).Value = nomMassif1.Offset(0, -3).Value Then
        Sheets("visio").Range("a" & y).EntireRow.Value = .Range("a" & x).EntireRow.Value
        y = y + 1
        End If
    Next x
    nlvisio = Sheets("visio").Range("d" & Rows.Count).End(xlUp).Row
    Set nomMassif1 = Sheets("visio").Range("d2:d" & nlvisio).Find(ParNom)
    Sheets("visio").Range("a" & nomMassif1.Row, "ah" & nomMassif1.Row).Interior.ColorIndex = 43

Mon premier combobox : selection de la liste [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager