listbox en chaine

**crisjoce** · 15/11/2015, 11h40

Bonjour
je viens de trouver comment faire des listbox.
Je souhaiterais quand je selectionne dans la premiere lstbox
qui recherche dans les rubriques la selection, et me donne une deuxieme listbox (phases).
idem pour pour la deuxieme.

de plus quandj'ai valider dans les listbox, les résultats s'inscrivent dans la feuille,
et queje puise refaire des autres choix, et qui s'ecrive a la suite des choix précédents.

ci joint mon fihier

**Daniel.C** · 15/11/2015, 12h21

Bonjour,

Si je sélectionne une rubrique de la première listbox, quelle doit être la liste correspondante dans la seconde listbox ? et ainsi de suite. Pourquoi y a-t-il deuxx listes APS et APD ?

**crisjoce** · 15/11/2015, 12h49

Voici la liste complete des parametres ci apres

LOT ELEC APS - Repérages sur site
LOT ELEC APS - Analyse des documents d'entrée
LOT ELEC APS - Liste équipements prédimensionnés
LOT ELEC APS - Liste instruments / BDD
LOT ELEC APS - PID
LOT ELEC APS - Notes de calcul
LOT ELEC APS - Bilan de puissance
LOT ELEC APS - Principes généraux de conduite de l’installation
LOT ELEC APS - Note technique
LOT ELEC APS - Revues, Gestion documentaire & TQC / DOE
LOT ELEC APD - Repérages sur site
LOT ELEC APD - Analyse modifications et récupération des plans existants
LOT ELEC APD - Schéma de principe distribution électrique
LOT ELEC APD - Liste des consommateurs
LOT ELEC APD - Liste instruments / BDD
LOT ELEC APD - PID
LOT ELEC APD - Notes de calcul
LOT ELEC APD - Bilan de puissance
LOT ELEC APD - Carnet de câbles
LOT ELEC APD - Définition préliminaire des boucles
LOT ELEC APD - Plan de situation des équipements
LOT ELEC APD - Schéma des interliaisons
LOT ELEC APD - Spécifications générales élec/instrum
LOT ELEC APD - Revues, Gestion documentaire & TQC / DOE

**Daniel.C** · 15/11/2015, 16h30

Si tu definis ListBox1 et ListBox2 comme multiselect, il te faut un bouton avec chaque listbox pour signifier que tu as fini tes choix.

**crisjoce** · 15/11/2015, 16h40

je souhaite quand j'ai cliquer sur la 1 listbox avec le choix lot elec, qu'apparait une autre listbox avec choix aps et apd , quand je choisi l'un ou l'autre une 3eme listbox s'ouvre avec une selection multiple multiples.
j'ai un bouton valider, que ces valeurs s'écrivent dans une feuille.
que les listbox reviennent a zero, que je fasse une autre recherche, et que cela s'ecrive a la suite de ma 1ere recherche.
et quand j'ai fini je clique sur le bouton exit et que l'userform s'echappe

**Daniel.C** · 15/11/2015, 18h06

Regarde le code suivant. 9a fonctionne sans les boutons. Je ne sais pas ce que tu veux faire avec le bouton "Valider". Choisis dans ListBox1; clique dans Listbox2, fais tes chois; de même, clique dans ListBox3 et fais tes choix. Voici le code du module :

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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
Dim Dico As Object
 
Private Sub Bt_Valider_Click()
'Private Sub CommandButton1_Click()
Dim I As Integer, y As Integer
 
    With Me.ListBox1
    For I = 0 To .ListCount - 1
    If .Selected(I) = True Then
 
    y = y + 1
    Range("A" & y).Value = .List(I)
    End If
    Next I
    End With
 
 
    With Me.ListBox2
    For I = 0 To .ListCount - 1
    If .Selected(I) = True Then
 
    y = y + 1
    Range("a" & y).Value = .List(I)
    End If
    Next I
    End With
 
    With Me.ListBox3
    For I = 0 To .ListCount - 1
    If .Selected(I) = True Then
 
    y = y + 1
    Range("a" & y).Value = .List(I)
    End If
    Next I
    End With
End Sub
 
 
Private Sub CommandButton2_Click()
Dim I As Integer
    With Me.ListBox1
    For I = 0 To .ListCount - 1
    If .Selected(I) = True Then
    [C1] = [C1] & " " & .List(I)
    End If
    Next I
    End With
End Sub
 
Private Sub CommandButton1_Click()
 Unload UserForm1
End Sub
 
 
 
Private Sub ListBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim C As Range, Ligne As Long
'    Dico.RemoveAll
    With Feuil2
        Var = Dico.keys
        For I = 0 To Me.ListBox2.ListCount - 1
            If Me.ListBox2.Selected(I) Then
                For Each C In .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
                    For j = 1 To UBound(Var)
                        If C.Value = Me.ListBox1.List(I) And Split(Var(j), "|")(0) = C.Value And _
                            Split(Var(j), "|")(1) = C.Offset(, 1).Value Then
                            Me.ListBox3.AddItem C.Offset(, 2).Value
                        End If
                    Next j
                Next C
            End If
        Next I
    End With
End Sub
 
Private Sub ListBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim C As Range, Ligne As Long
    With Feuil2
        .[F:G].ClearContents
        For I = 0 To Me.ListBox1.ListCount - 1
            If Me.ListBox1.Selected(I) Then
                For Each C In .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
                    If C.Value = Me.ListBox1.List(I) Then
                        If Not Dico.exists(C.Value & "|" & C.Offset(, 1).Value) Then
                            Dico.Add C.Value & "|" & C.Offset(, 1).Value, C.Value & "|" & C.Offset(, 1).Value
                            Me.ListBox2.AddItem C.Offset(, 1).Value
                        End If
                    End If
                Next C
            End If
        Next I
    End With
End Sub
 
 
Private Sub UserForm_Initialize()
    Set Dico = CreateObject("Scripting.Dictionary")
End Sub

**crisjoce** · 16/11/2015, 08h48

Bonjour
merci pour ta reponse, je ne vois pas la difference entre les deux codes.
Le bouton valider sert a envoyer les donnees sur la feuille 1.
je souhaiterais ensuite mettre a blenc les choix fait dans les listbox, et effectuer
d'autre saisiess, qui une fois valider se mettrais a suivrent des donnees deja inscritent
dans la feuille 1. puis faire quitter pour partir de l'userforms.

**Daniel.C** · 16/11/2015, 11h49

Bonjour,

merci pour ta reponse, je ne vois pas la difference entre les deux codes.

Dans le classeur que tu mis en PJ, le remplissage des listboxes 2 et 3 était fixe. Avec mon code, le choix de la listbox1 conditionne le remplissage de la listbox2 et, pareillement, le choix dans la listbox2 conditionne le remplissage de la listbox3 ainsi que tu l'as demandé. C'est curieux que tu ne t'en sois pas aperçu !

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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
Dim Dico As Object
 
Private Sub Bt_Valider_Click()
'Private Sub CommandButton1_Click()
Dim I As Integer, y As Integer
    y = Cells(Rows.Count, 1).End(xlUp).Row
    If y = 1 Then y = 0
    With Me.ListBox1
    For I = 0 To .ListCount - 1
    If .Selected(I) = True Then
 
    y = y + 1
    Range("A" & y).Value = .List(I)
    End If
    Next I
    End With
 
 
    With Me.ListBox2
    For I = 0 To .ListCount - 1
    If .Selected(I) = True Then
 
    y = y + 1
    Range("a" & y).Value = .List(I)
    End If
    Next I
    End With
 
    With Me.ListBox3
    For I = 0 To .ListCount - 1
    If .Selected(I) = True Then
 
    y = y + 1
    Range("a" & y).Value = .List(I)
    End If
    Next I
    End With
 
    For I = 0 To Me.ListBox1.ListCount - 1
        Me.ListBox1.Selected(I) = False
    Next I
    For I = 0 To Me.ListBox2.ListCount - 1
        Me.ListBox2.RemoveItem 0
    Next I
    For I = 0 To Me.ListBox3.ListCount - 1
        Me.ListBox3.RemoveItem 0
    Next I
 
End Sub
 
 
Private Sub CommandButton2_Click()
Dim I As Integer
    With Me.ListBox1
    For I = 0 To .ListCount - 1
    If .Selected(I) = True Then
    [C1] = [C1] & " " & .List(I)
    End If
    Next I
    End With
End Sub
 
Private Sub CommandButton1_Click()
 Unload UserForm1
End Sub
 
 
'Private Sub ListBox1_Change()
'    Dim C As Range, Ligne As Long
'    With Feuil2
'        .[F:F].ClearContents
'        For I = 0 To Me.ListBox1.ListCount - 1
'            If Me.ListBox1.Selected(I) Then
'                For Each C In .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
'                    If C.Value = Me.ListBox1.List(I) Then
'                        If Application.CountIf(.[F:F], C.Offset(, 1).Value) = 0 Then
'                            Ligne = Ligne + 1
'                            .Cells(Ligne, 6).Value = C.Offset(, 1).Value
'                        End If
'                    End If
'                Next C
'            End If
'        Next I
'        Me.ListBox2.RowSource = "=Feuil2!" & .Range("F1", .Cells(.Rows.Count, 6).End(xlUp)).Address
'    End With
'End Sub
 
Private Sub ListBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim C As Range, Ligne As Long
'    Dico.RemoveAll
    With Feuil2
        Var = Dico.keys
        For I = 0 To Me.ListBox2.ListCount - 1
            If Me.ListBox2.Selected(I) Then
                For Each C In .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
                    For j = 1 To UBound(Var)
                        If C.Value = Me.ListBox1.List(I) And Split(Var(j), "|")(0) = C.Value And _
                            Split(Var(j), "|")(1) = C.Offset(, 1).Value Then
                            Me.ListBox3.AddItem C.Offset(, 2).Value
                        End If
                    Next j
                Next C
            End If
        Next I
    End With
End Sub
 
Private Sub ListBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim C As Range, Ligne As Long
    With Feuil2
        .[F:G].ClearContents
        For I = 0 To Me.ListBox1.ListCount - 1
            If Me.ListBox1.Selected(I) Then
                For Each C In .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
                    If C.Value = Me.ListBox1.List(I) Then
                        If Not Dico.exists(C.Value & "|" & C.Offset(, 1).Value) Then
                            Dico.Add C.Value & "|" & C.Offset(, 1).Value, C.Value & "|" & C.Offset(, 1).Value
                            Me.ListBox2.AddItem C.Offset(, 1).Value
                        End If
                    End If
                Next C
            End If
        Next I
    End With
End Sub
 
 
Private Sub UserForm_Initialize()
    Set Dico = CreateObject("Scripting.Dictionary")
    Me.ListBox1.ListIndex = -1
    Me.ListBox2.ListIndex = -1
    Me.ListBox3.ListIndex = -1
End Sub

**crisjoce** · 16/11/2015, 12h09

je ne vois pas le choix de la listbox1 conditionne le remplissage de la listbox2
et j'ai une erreur a Me.ListBox2.RemoveItem 0

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
For I = 0 To Me.ListBox1.ListCount - 1
        Me.ListBox1.Selected(I) = False
    Next I
    For I = 0 To Me.ListBox2.ListCount - 1
 
 
        Me.ListBox2.RemoveItem 0
 
 
    Next I
    For I = 0 To Me.ListBox3.ListCount - 1
        Me.ListBox3.RemoveItem 0
    Next I
 
End Sub

j'ai remplacer

Code :

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

Me.ListBox2.RemoveItem 0

par

Code :

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

Me.ListBox2.Selected(I) = False

**Daniel.C** · 16/11/2015, 13h21

j'ai remplacer
Me.ListBox2.RemoveItem 0
par
Me.ListBox2.Selected(I) = False

Non !

Dis-moi précisément toutes les manipulations que tu fais pour arriver à l'erreur.

**crisjoce** · 16/11/2015, 16h23

j'ai fait un code mais chaque nlle selection ne s'ecrivent pas a la suite des donnees anterieures
comment faire?

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
57
58
59
60
61
62
63
64
65
Dim f
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range(f.[A2], f.[A65000].End(xlUp))
    mondico(c.Value) = c.Value
  Next c
  Me.ListBox1.List = mondico.items
  Me.ListBox1.MultiSelect = fmMultiSelectMulti
End Sub
Private Sub ListBox1_Change()
    Me.ListBox3.Clear
    Set mondico = CreateObject("Scripting.Dictionary")
    For Each c In Range(f.[A2], f.[C65000].End(xlUp))
        For k = 0 To Me.ListBox1.ListCount - 1
          If Me.ListBox1.Selected(k) = True Then
            If c = Me.ListBox1.List(k, 0) Then
              temp = c.Offset(, 1)
              mondico(temp) = temp
            End If
          End If
        Next k
    Next c
    Me.ListBox2.List = mondico.items
End Sub
Private Sub ListBox2_Change()
  Me.ListBox3.Clear
  For Each c In Range(f.[B2], f.[B65000].End(xlUp))
    For k = 0 To Me.ListBox2.ListCount - 1
      If Me.ListBox2.Selected(k) = True Then
        If c = Me.ListBox2.List(k, 0) Then Me.ListBox3.AddItem c.Offset(, 1)
      End If
     Next k
  Next c
End Sub
Private Sub b_ok_Click()
Sheets("Feuil1").Select
   [A4:C200].ClearContents
   ligne = 2
 
   For k = 0 To Me.ListBox1.ListCount - 1
     If Me.ListBox1.Selected(k) = True Then
       Cells(ligne, "b") = "" & Me.ListBox1.List(k, 0)
       ligne = ligne + 1
     End If
   Next k
 
   For k = 0 To Me.ListBox2.ListCount - 1
     If Me.ListBox2.Selected(k) = True Then
       Cells(ligne, "b") = "" & Me.ListBox2.List(k, 0)
       ligne = ligne + 1
     End If
   Next k
 
   For k = 0 To Me.ListBox3.ListCount - 1
     If Me.ListBox3.Selected(k) = True Then
       Cells(ligne, "b") = "" & Me.ListBox3.List(k, 0)
       ligne = ligne + 1
     End If
   Next k
 
'   f.Range("A2:C1000").AdvancedFilter Action:=xlFilterCopy, _
'        CriteriaRange:=Range("A1").CurrentRegion, CopyToRange:=Range("A2:C2"), unique:=False
'   Unload Me
End Sub

**Daniel.C** · 16/11/2015, 16h37

Est-ce que mon code fonctionne, lui ?

**crisjoce** · 17/11/2015, 08h59

bonjour
ton code fonctionne en partie.
quand je lance l'userform, je peux selectionner lotelect, le secon APS, et sur la troisieme le contenu est tojours le meme
alors que si je clique sur lotautom et APD, la 3eme listbox devrait etre differente.
de plus comme je l'ai ecris avant, j'ai remplacer
Me.ListBox2.RemoveItem 0 par Me.ListBox2.Selected(I) = False , qui fonctionne.

alors que sur le code ci apres, les choix donnees sont bien placees dans chaque listbox..
Sauf que les donnees ne s'ecrivent pas a la suite des autres donnees dans la feuille.

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
57
58
59
60
61
Dim f
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range(f.[A2], f.[A65000].End(xlUp))
    mondico(c.Value) = c.Value
  Next c
  Me.ListBox1.List = mondico.items
  Me.ListBox1.MultiSelect = fmMultiSelectMulti
End Sub
Private Sub ListBox1_Change()
    Me.ListBox3.Clear
    Set mondico = CreateObject("Scripting.Dictionary")
    For Each c In Range(f.[A2], f.[C65000].End(xlUp))
        For k = 0 To Me.ListBox1.ListCount - 1
          If Me.ListBox1.Selected(k) = True Then
            If c = Me.ListBox1.List(k, 0) Then
              temp = c.Offset(, 1)
              mondico(temp) = temp
            End If
          End If
        Next k
    Next c
    Me.ListBox2.List = mondico.items
End Sub
Private Sub ListBox2_Change()
  Me.ListBox3.Clear
  For Each c In Range(f.[B2], f.[B65000].End(xlUp))
    For k = 0 To Me.ListBox2.ListCount - 1
      If Me.ListBox2.Selected(k) = True Then
        If c = Me.ListBox2.List(k, 0) Then Me.ListBox3.AddItem c.Offset(, 1)
      End If
     Next k
  Next c
End Sub
Private Sub b_ok_Click()
Sheets("Feuil1").Select
   [A4:C200].ClearContents
   ligne = 2
 
   For k = 0 To Me.ListBox1.ListCount - 1
     If Me.ListBox1.Selected(k) = True Then
       Cells(ligne, "b") = "" & Me.ListBox1.List(k, 0)
       ligne = ligne + 1
     End If
   Next k
 
   For k = 0 To Me.ListBox2.ListCount - 1
     If Me.ListBox2.Selected(k) = True Then
       Cells(ligne, "b") = "" & Me.ListBox2.List(k, 0)
       ligne = ligne + 1
     End If
   Next k
 
   For k = 0 To Me.ListBox3.ListCount - 1
     If Me.ListBox3.Selected(k) = True Then
       Cells(ligne, "b") = "" & Me.ListBox3.List(k, 0)
       ligne = ligne + 1
     End If
   Next k
End Sub

**Daniel.C** · 17/11/2015, 11h27

de plus comme je l'ai ecris avant, j'ai remplacer

Code :

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

Me.ListBox2.RemoveItem 0

par

Code :

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

Me.ListBox2.Selected(I) = False

, qui fonctionne.

Ca ne fonctionnera pas si tu fais une autre sélection sans fermer l'userform.

Sauf que les donnees ne s'ecrivent pas a la suite des autres donnees dans la feuille.

Ben oui. Le code initial écrivait les choix des trois listboxes en colonne A à partir de A1. Je l'ai modifié pour écrire les données les unes sous les autres. Regarde-le.

**crisjoce** · 17/11/2015, 13h43

j'ai regarder le code, mais la 3eme listbox ne change pas quand je change de chois dans le 2eme.

je souhaiterais t'envoyer mon fichier rectifier, avec la nlle macro.
mais je n'arrive pas a l'attacher.

il ne manque pas grand chose je pense pour dire que les nlles donnees choisis s'ecrivent a la suite
des donnees deja inscritent.

cordialement
cris

**Daniel.C** · 17/11/2015, 18h56

Avec les résultats en colonnes A, B et C :

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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
        'Daniel Josserand Avril 2005
'*********Microsoft MVP Excel 2001 - 2005*********
Dim Dico As Object, Dico2 As Object
 
Private Sub Bt_Valider_Click()
'Private Sub CommandButton1_Click()
Dim I As Integer, y As Integer
    If [A1] = "" Then
        Ligne = 0
    Else
        Ligne = [A:C].Find("*", , , , xlByRows, xlPrevious).Row
    End If
    With Me.ListBox1
        y = Ligne
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
 
        y = y + 1
        Range("A" & y).Value = .List(I)
        End If
        Next I
    End With
 
 
    With Me.ListBox2
        y = Ligne
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
        y = y + 1
        Range("B" & y).Value = .List(I)
        End If
        Next I
    End With
 
    With Me.ListBox3
        y = Ligne
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
 
        y = y + 1
        Range("C" & y).Value = .List(I)
        End If
        Next I
    End With
 
    For I = 0 To Me.ListBox1.ListCount - 1
        Me.ListBox1.Selected(I) = False
    Next I
    For I = 0 To Me.ListBox2.ListCount - 1
        Me.ListBox2.RemoveItem 0
    Next I
    For I = 0 To Me.ListBox3.ListCount - 1
        Me.ListBox3.RemoveItem 0
    Next I
 
End Sub
 
 
Private Sub CommandButton2_Click()
Dim I As Integer
    With Me.ListBox1
    For I = 0 To .ListCount - 1
    If .Selected(I) = True Then
    [C1] = [C1] & " " & .List(I)
    End If
    Next I
    End With
End Sub
 
Private Sub CommandButton1_Click()
 Unload UserForm1
End Sub
 
 
 
Private Sub ListBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim C As Range, Ligne As Long
    Dico2.RemoveAll
    With Feuil2
        Var = Dico.keys
        For I = 0 To Me.ListBox2.ListCount - 1
            If Me.ListBox2.Selected(I) Then
                For Each C In .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
                    For j = 1 To UBound(Var)
                        If C.Offset(, 1) = Me.ListBox2.List(I) And C.Value = Split(Var(j), "|")(0) And _
                        Split(Var(j), "|")(1) = Me.ListBox2.List(I) Then
'                            if not dico2.exists(Split(Var(j) & "|"
                            Debug.Print Split(Var(j), "|")(1)
                            Me.ListBox3.AddItem C.Offset(, 2).Value
                        End If
                    Next j
'                    If Not Dico.exists(C.Value & "|" & C.Offset(, 1).Value) Then
'                        Me.ListBox3.AddItem C.Offset(, 2).Value
'                    End If
                Next C
            End If
        Next I
    End With
End Sub
 
Private Sub ListBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim C As Range, Ligne As Long
    With Feuil2
        .[F:G].ClearContents
        For I = 0 To Me.ListBox1.ListCount - 1
            If Me.ListBox1.Selected(I) Then
                For Each C In .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
                    If C.Value = Me.ListBox1.List(I) Then
                        If Not Dico.exists(C.Value & "|" & C.Offset(, 1).Value) Then
                            Dico.Add C.Value & "|" & C.Offset(, 1).Value, C.Value & "|" & C.Offset(, 1).Value
                            Me.ListBox2.AddItem C.Offset(, 1).Value
                        End If
                    End If
                Next C
            End If
        Next I
    End With
End Sub
 
 
Private Sub UserForm_Initialize()
    Set Dico = CreateObject("Scripting.Dictionary")
    Set Dico2 = CreateObject("Scripting.Dictionary")
    Me.ListBox1.ListIndex = -1
    Me.ListBox2.ListIndex = -1
    Me.ListBox3.ListIndex = -1
End Sub

**crisjoce** · 18/11/2015, 08h59

Bonjour
j'ai tester le code. il me donne bien 3 listbox
mais j'ai des doublons, quand je clique sur ex. Lotelect je souhaiterais avoir dans le 2emm
APS,APD c'est a dire les choix en correspondance avec lotelect.
idem pour le 3 listbox.
de plus je suis obliger de quitter l'userform pour refaire un choix.

le code suivant fonctionne come je le souhaiterais mais les donnees une fois selectionnes ne se mettre pas a suivrent des donnees precedentes.

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
57
58
59
60
61
62
63
64
65
Dim f
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range(f.[A2], f.[A65000].End(xlUp))
    mondico(c.Value) = c.Value
  Next c
  Me.ListBox1.List = mondico.items
  Me.ListBox1.MultiSelect = fmMultiSelectMulti
End Sub
Private Sub ListBox1_Change()
    Me.ListBox3.Clear
    Set mondico = CreateObject("Scripting.Dictionary")
    For Each c In Range(f.[A2], f.[C65000].End(xlUp))
        For k = 0 To Me.ListBox1.ListCount - 1
          If Me.ListBox1.Selected(k) = True Then
            If c = Me.ListBox1.List(k, 0) Then
              temp = c.Offset(, 1)
              mondico(temp) = temp
            End If
          End If
        Next k
    Next c
    Me.ListBox2.List = mondico.items
End Sub
Private Sub ListBox2_Change()
  Me.ListBox3.Clear
  For Each c In Range(f.[B2], f.[B65000].End(xlUp))
    For k = 0 To Me.ListBox2.ListCount - 1
      If Me.ListBox2.Selected(k) = True Then
        If c = Me.ListBox2.List(k, 0) Then Me.ListBox3.AddItem c.Offset(, 1)
      End If
     Next k
  Next c
End Sub
Private Sub b_ok_Click()
 
 
Sheets("Feuil1").Select
'   [A4:C200].ClearContents
   ligne = 2
 
   For k = 0 To Me.ListBox1.ListCount - 1
     If Me.ListBox1.Selected(k) = True Then
       Cells(ligne, "b") = "" & Me.ListBox1.List(k, 0)
       ligne = ligne + 1
     End If
   Next k
 
   For k = 0 To Me.ListBox2.ListCount - 1
     If Me.ListBox2.Selected(k) = True Then
       Cells(ligne, "b") = "" & Me.ListBox2.List(k, 0)
       ligne = ligne + 1
     End If
   Next k
 
   For k = 0 To Me.ListBox3.ListCount - 1
     If Me.ListBox3.Selected(k) = True Then
       Cells(ligne, "b") = "" & Me.ListBox3.List(k, 0)
       ligne = ligne + 1
     End If
   Next k
 
 
End Sub

**Daniel.C** · 18/11/2015, 10h50

Les choix correspondant à lot elec sont : APS, APD et étude de détail. C'est bien ce que j'observe :

Nom : Capture.PNG
Affichages : 119
Taille : 2,7 Ko

le code suivant fonctionne come je le souhaiterais mais les donnees une fois selectionnes ne se mettre pas a suivrent des donnees precedentes.

Si :

Nom : Capture.PNG
Affichages : 110
Taille : 7,3 Ko

Pour pouvoir faire plusieurs saisies sans fermer le userform, remplace la macro :

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
Private Sub Bt_Valider_Click()
'Private Sub CommandButton1_Click()
Dim I As Integer, y As Integer
    If [A1] = "" Then
        Ligne = 0
    Else
        Ligne = [A:C].Find("*", , , , xlByRows, xlPrevious).Row
    End If
    With Me.ListBox1
        y = Ligne
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
 
        y = y + 1
        Range("A" & y).Value = .List(I)
        End If
        Next I
    End With
 
 
    With Me.ListBox2
        y = Ligne
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
        y = y + 1
        Range("B" & y).Value = .List(I)
        End If
        Next I
    End With
 
    With Me.ListBox3
        y = Ligne
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
 
        y = y + 1
        Range("C" & y).Value = .List(I)
        End If
        Next I
    End With
 
    For I = 0 To Me.ListBox1.ListCount - 1
        Me.ListBox1.Selected(I) = False
    Next I
    For I = 0 To Me.ListBox2.ListCount - 1
        Me.ListBox2.RemoveItem 0
    Next I
    For I = 0 To Me.ListBox3.ListCount - 1
        Me.ListBox3.RemoveItem 0
    Next I
    Me.ListBox1.SetFocus
    Dico.RemoveAll
End Sub

**crisjoce** · 19/11/2015, 09h56

ok

Bonjour
J' aimerais que les donnees s'ecrivent a partir de b14

LOTELEC
APS
- Repérages sur site
- Analyse des documents d'entrée

et la suite des donnees a suivre en B

**crisjoce** · 19/11/2015, 14h02

j'ai reussit pour la derniere question.
le code fonctionne bien.
je souhaiterais que le choix de la listbox1 et 2
c'est a dire Lotelect, et APS soit avec la selection ci aores, mais je ne suis pas arriver a positionner correctement
le code ci dessous

Code :

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

1
2
3
4
5
6
7
8
9
    With Selection.Font
        .Name = "Calibri"
        .Size = 9
        .Bold = True
    With Selection.Font
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0
    End With
    End With

je souhaiterais que le choix de la listbox3

le code ci dessous

Code :

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

1
2
3
4
5
6
7
8
9
10
11
    With Selection
        .HorizontalAlignment = xlLeft
        .IndentLevel = 1
    End With
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Normal"
        .Size = 9
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = -0.249977111117893
    End With

le code actuel pour le post initial fonctionne

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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
Dim f
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range(f.[A2], f.[A65000].End(xlUp))
    mondico(c.Value) = c.Value
  Next c
  Me.ListBox1.List = mondico.items
  Me.ListBox1.MultiSelect = fmMultiSelectMulti
End Sub
Private Sub ListBox1_Change()
    Me.ListBox3.Clear
    Set mondico = CreateObject("Scripting.Dictionary")
    For Each c In Range(f.[A2], f.[C65000].End(xlUp))
        For k = 0 To Me.ListBox1.ListCount - 1
          If Me.ListBox1.Selected(k) = True Then
            If c = Me.ListBox1.List(k, 0) Then
              temp = c.Offset(, 1)
              mondico(temp) = temp
            End If
 
          End If
        Next k
    Next c
 
    Me.ListBox2.List = mondico.items
End Sub
Private Sub ListBox2_Change()
  Me.ListBox3.Clear
  For Each c In Range(f.[B2], f.[B65000].End(xlUp))
    For k = 0 To Me.ListBox2.ListCount - 1
      If Me.ListBox2.Selected(k) = True Then
        If c = Me.ListBox2.List(k, 0) Then Me.ListBox3.AddItem c.Offset(, 1)
      End If
     Next k
  Next c
End Sub
Private Sub CommandButton1_Click()
 
'Sheets("feuil3").Activate
 
Dim I As Integer, y As Integer
    If [B12] = "*" Then
        Ligne = 0
    Else
        Ligne = [A:C].Find("*", , , , xlByRows, xlPrevious).Row
    End If
 
    With Me.ListBox1
        y = Ligne
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
        y = y + 1
        Range("B" & y).Value = .List(I)
    End If
    Next I
    End With
 
    With Me.ListBox2
        y = Ligne
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
        y = y + 1
        Range("B" & y + 1).Value = .List(I)
        End If
        Next I
 
    End With
 
 
    With Me.ListBox3
        y = Ligne
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
        y = y + 1
        Range("B" & y + 2).Value = .List(I)
        End If
    Next I
 
    End With
 
 
    For I = 0 To Me.ListBox1.ListCount - 1
    Me.ListBox1.Selected(I) = False
    Next I
    For I = 0 To Me.ListBox2.ListCount - 1
        Me.ListBox2.RemoveItem 0
    Next I
    For I = 0 To Me.ListBox3.ListCount - 1
        Me.ListBox3.RemoveItem 0
    Next I
    Me.ListBox1.SetFocus
    'Dico.RemoveAll
 
End Sub

listbox en chaine [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager