pb avec la listbox

Version imprimable

pb avec la listbox

Bonjour,

J'essaye tout juste les listbox et j'avoue que je galère un peu... (beaucoup)

1) J'ai un problème concernant déjà l'initialisation du userform. Il se fait lorsque je clique sur un bouton et ca bloque en me disant: "incompatibilité de type" (erreur 13) et la ligne en jaune suivant s'affiche:

ce code est dans le module 1

Code:

1
2
3
Sub Bouton2_Cliquer()
UserForm1.Show 'cette ligne ... étrange car le userform 1 existe...
End Sub

le truc c'est qu'il n'y a pas de messages d'erreurs si j'enlève ce code dans l'userform

Code:

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
Private Sub UserForm_Initialize()
    Dim i&, fin&, aa, bb, mondico As Object
    With Feuil1 'feuille Appro
        fin = .Range("A" & Rows.Count).End(xlUp).Row
        aa = .Range("A2:AH" & fin)
    End With
    Set mondico = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(aa)
        If aa(i, 1) <> "" And Not mondico.exists(aa(i, 1)) Then mondico.Add aa(i, 1), aa(i, 1) ' indice 1 corresppond au champ réf
    Next i
    bb = Application.Transpose(mondico.items)
    C1.List = bb
    mondico.RemoveAll
    For i = 1 To UBound(aa)
        If aa(i, 2) <> "" And Not mondico.exists(aa(i, 2)) Then mondico.Add aa(i, 2), aa(i, 2) ' indice 2 corresppond au champ n° PR
    Next i
    bb = Application.Transpose(mondico.items)
    C2.List = bb
    mondico.RemoveAll
    For i = 1 To UBound(aa)
        If aa(i, 3) <> "" And Not mondico.exists(aa(i, 3)) Then mondico.Add aa(i, 3), aa(i, 3) ' indice 3 corresppond au champ exp PR
    Next i
    bb = Application.Transpose(mondico.items)
    C3.List = bb
    mondico.RemoveAll
    For i = 1 To UBound(aa)
        If aa(i, 4) <> "" And Not mondico.exists(aa(i, 4)) Then mondico.Add aa(i, 4), aa(i, 4) ' indice 4 corresppond au champ fiche consigne
    Next i
    bb = Application.Transpose(mondico.items)
    C4.List = bb
    mondico.RemoveAll
 
    For i = 1 To UBound(aa)
        If aa(i, 5) <> "" And Not mondico.exists(aa(i, 5)) Then mondico.Add aa(i, 5), aa(i, 5) ' indice 5 corresppond au champ exp fiche consigne
    Next i
    bb = Application.Transpose(mondico.items)
    C5.List = bb
    mondico.RemoveAll
 
End Sub

2) voici le code que j'ai essayé en fouillant un peu partout. J'ai donc dans luserform1 5combobox dans lesquel je voudrai récupérer les données (combobox1 reprend les donénes de la colonne 1, le combobox2 pour la colonne 2 etc..) puis que la listbox affiche les valeurs (comme un filtre). J'ai donc ce code: est-il bien pour ce que je veux faire?

Code:

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
Option Explicit
Option Base 1
Option Compare Text
Dim a1$, a2$, a3$, a4$, a5$
 
 
 
Private Sub C1_Change() ' Combobox référence de l'userform
    If C1 = "" Then C1_Click
End Sub
 
Private Sub C2_Change() ' Combobox n° PR de l'userform
    If C2 = "" Then C1_Click
End Sub
 
Private Sub C3_Change() ' Combobox Date exp PR de l'userform
    If C3 = "" Then C1_Click
End Sub
Private Sub C4_Change() ' Combobox FICHE CONSIGNE de l'userform
    If C4 = "" Then C1_Click
End Sub
Private Sub C5Change() ' Combobox date exp FICHE CONSIGNE de l'userform
    If C5 = "" Then C1_Click
End Sub
Private Sub C1_Click() ' Combobox Référence de l'userform
    Dim i&, fin&, y&, a&, aa
    Application.ScreenUpdating = 0
    If C1 = "" Then a1 = "*" Else a1 = C1
    If C2 = "" Then a2 = "*" Else a2 = C2
    If C3 = "" Then a3 = "*" Else a3 = C3
    If C4 = "" Then a4 = "*" Else a4 = C4
    If C5 = "" Then a5 = "*" Else a5 = C5
 
    If a1 = "*" And a2 = "*" And a3 = "*" And a4 = "*" And a5 = "*" Then L1.Clear: Exit Sub
    L1.Clear
    With Feuil1 'feuille Appro
        y = 2
        fin = .Range("A" & Rows.Count).End(xlUp).Row
        aa = .Range("A2:AH" & fin)
    End With
    For i = 1 To UBound(aa)
            If aa(i, 1) Like a1 And aa(i, 2) Like a2 And aa(i, 3) Like a3 And aa(i, 4) Like a4 And aa(i, 5) Like a5 Then aa(i, 22) = "OUI": y = y + 1
    Next i
    If y = 1 Then Exit Sub
    If y = 2 Then
    ReDim bb(1, 2)
        For i = 1 To UBound(aa)
            If aa(i, 22) = "oui" Then
                For a = 1 To 22
                    bb(1, a) = aa(i, a)
                Next a
              GoTo 1
            End If
       Next i
    Else
        ReDim bb(y - 1, UBound(aa, 2) - 1)
        y = 1
        For i = 1 To UBound(aa)
            If aa(i, 22) = "OUI" Then
                For a = 1 To 22
                    bb(y, a) = aa(i, a)
                Next a
                y = y + 1
            End If
        Next i
   End If
    With L1
        .ColumnCount = 5 ' nombre de colonnes dans la list box L1
        .ColumnWidths = "100;100;100;100;100" 'largeur des champs dans la listbox L1
        .List = bb
    End With
End Sub
 
Private Sub C2_Click() ' Combobox n° PR de l'userform
    C1_Click
End Sub
 
Private Sub C3_Click() ' Combobox exp PR de l'userform
    C1_Click
End Sub
 
Private Sub C4_Click() ' Combobox fiche consigne de l'userform
    C1_Click
End Sub
Private Sub C5_Click() ' Combobox exp fiche consigne  de l'userform
   C1_Click
End Sub
 
 
Private Sub UserForm_Initialize()
    Dim i&, fin&, aa, bb, mondico As Object
    With Feuil1 'feuille Appro
        fin = .Range("A" & Rows.Count).End(xlUp).Row
        aa = .Range("A2:AH" & fin)
    End With
    Set mondico = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(aa)
        If aa(i, 1) <> "" And Not mondico.exists(aa(i, 1)) Then mondico.Add aa(i, 1), aa(i, 1) ' indice 1 corresppond au champ réf
    Next i
    bb = Application.Transpose(mondico.items)
    C1.List = bb
    mondico.RemoveAll
    For i = 1 To UBound(aa)
        If aa(i, 2) <> "" And Not mondico.exists(aa(i, 2)) Then mondico.Add aa(i, 2), aa(i, 2) ' indice 2 corresppond au champ n° PR
    Next i
    bb = Application.Transpose(mondico.items)
    C2.List = bb
    mondico.RemoveAll
    For i = 1 To UBound(aa)
        If aa(i, 3) <> "" And Not mondico.exists(aa(i, 3)) Then mondico.Add aa(i, 3), aa(i, 3) ' indice 3 corresppond au champ exp PR
    Next i
    bb = Application.Transpose(mondico.items)
    C3.List = bb
    mondico.RemoveAll
    For i = 1 To UBound(aa)
        If aa(i, 4) <> "" And Not mondico.exists(aa(i, 4)) Then mondico.Add aa(i, 4), aa(i, 4) ' indice 4 corresppond au champ fiche consigne
    Next i
    bb = Application.Transpose(mondico.items)
    C4.List = bb
    mondico.RemoveAll
 
    For i = 1 To UBound(aa)
        If aa(i, 5) <> "" And Not mondico.exists(aa(i, 5)) Then mondico.Add aa(i, 5), aa(i, 5) ' indice 5 corresppond au champ exp fiche consigne
    Next i
    bb = Application.Transpose(mondico.items)
    C5.List = bb
    mondico.RemoveAll
 
End Sub

3) comment mettre une ligne dans ma listbox en première position pour avoir les titres? (Nom en colonne 1, Prénom en colonne 2 par exemple etc...

Merci d'avance de votre aide.

24/04/2014, 11h55
casefayere

Bonjour,
intègres des points d'arrêt dans ton code "Private Sub UserForm_Initialize()", exemple 1er point d'arrêt après le 1er "End With", vérifies si jusque là ça fonctionne et ainsi de suite, perso je doute déjà de "With Feuil1" mais tu gères peut-être bien cette formulation...
24/04/2014, 12h15
bboy-eazy

1 pièce(s) jointe(s)

Bonjour Casefayere,

j'ai mis un point d'arret au premier end with et ca bloque déjà...

Alors non non non je ne maitrise pas du tout la formulation de tout le code même. Je commence tout juste à essayer les listbox et j'ai vraiment du mal..

ci-joint le classeur si ca peut aider..
24/04/2014, 12h21
mercatog
Ajoute un test si ton dico ne contient pas de valeurs
Code:

1 2 3 4 If mondico.Count > 0 Then bb = Application.Transpose(mondico.items) C5.List = bb End If
PS, tu peux largement simplifier ton code qui comporte des parties quasi-identiques.

Bonjour mercatog, :chin:
tu as parfaitement raison mais en attendant sans chercher plus loin, j'ai corrigé le code afin que l'usf puisse s'ouvrir, après je te comprends, il y a du boulot !

Code:

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
 
Private Sub UserForm_Initialize()
    Dim i&, fin As Range, aa, bb, mondico As Object
   'feuille Appro
 
        Set fin = Worksheets("Appro").Range("A" & Rows.Count).End(xlUp)
        aa = Worksheets("Appro").Range("A2", fin(1, 7)) 'plage'a2 à G26
 
    Set mondico = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(aa, 1)
        If aa(i, 1) <> "" And Not mondico.exists(aa(i, 1)) Then mondico.Add aa(i, 1), aa(i, 1) ' indice 1 corresppond au champ réf
    Next i
    bb = Application.Transpose(mondico.items)
    C1.List = bb
    mondico.RemoveAll
    For i = 1 To UBound(aa)
        If aa(i, 2) <> "" And Not mondico.exists(aa(i, 2)) Then mondico.Add aa(i, 2), aa(i, 2) ' indice 2 corresppond au champ n° PR
    Next i
    bb = Application.Transpose(mondico.items)
    C2.List = bb
    mondico.RemoveAll
    For i = 1 To UBound(aa)
        If aa(i, 3) <> "" And Not mondico.exists(aa(i, 3)) Then mondico.Add aa(i, 3), aa(i, 3) ' indice 3 corresppond au champ exp PR
    Next i
    bb = Application.Transpose(mondico.items)
    C3.List = bb
    mondico.RemoveAll
    For i = 1 To UBound(aa)
        If aa(i, 4) <> "" And Not mondico.exists(aa(i, 4)) Then mondico.Add aa(i, 4), aa(i, 4) ' indice 4 corresppond au champ fiche consigne
    Next i
    bb = Application.Transpose(mondico.items)
    C4.List = bb
    mondico.RemoveAll
 
    For i = 1 To UBound(aa)
    'ci-dessous, s'il s'agit bien de la colonne 6 sinon adapter
        If aa(i, 6) <> "" And Not mondico.exists(aa(i, 6)) Then mondico.Add aa(i, 6), aa(i, 6) ' indice 5 corresppond au champ exp fiche consigne
    Next i
    bb = Application.Transpose(mondico.items)
    C5.List = bb
    mondico.RemoveAll
 
End Sub

Merci à vous deux pour vos réponse,

Et oui il y a du boulot mais à force de forger, on fait des belles lames bien droite :)

Sinon Casefayere peux tu m'expliquer ce qui bloquait car je n'arrive pas à voir... et tout marchait bien sauf quand j'ai changé cette partie du code en remplaçant 6 par 5 vu que c'est la colonne 5:
Code:

1 2 3 4 5 6 7 For i = 1 To UBound(aa) 'ci-dessous, s'il s'agit bien de la colonne 6 sinon adapter If aa(i, 6) <> "" And Not mondico.exists(aa(i, 6)) Then mondico.Add aa(i, 6), aa(i, 6) ' indice 5 corresppond au champ exp fiche consigne Next i bb = Application.Transpose(mondico.items) C5.List = bb mondico.RemoveAll
et tout marche bien si il y a quelque chose dans la colonne 5 sinon ca bug... d'ou l'ajout du test je pense pour savoir si mon dico contient des valeurs de Mercadog et il n'y aura pas forcément des valeurs.. mais je ne vois pas où placer ceci.. désolé je suis pas un expert..

Oui Mercatog je pense que ce code est simplifiable à fond mais bon je ne vois pas comment non plus à part peut être ajouter une autre variable j qui irait de 1 à 5? mais c'est un peu trop compliqué pour moi.. je vais tout faire buguer.

Sinon la structure pour faire un dico est bonne? ou je pars complètement dans une mauvaise direction?

Merci à vous deux pour l'interet que vous porter à ce sujet :) (qui doit être du pipi de chat pour vous mdr):pc:

Pour le remplissage des 5 Combos (Bonne chose de les nommer C1, C2...C5)

Code:

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
Private Sub UserForm_Initialize()
Dim k As Byte
 
For k = 1 To 5
    Remplissage Me.Controls("C" & k), k
Next k
End Sub
 
Private Sub Remplissage(ByVal Cmb As Object, ByVal Col As Integer)
Dim Fin As Long, i As Long
Dim MonDico As Object
Dim AA
 
With Worksheets("Appro")
    .AutoFilterMode = False
    Fin = .Cells(.Rows.Count, 1).End(xlUp).Row
    AA = .Range("A2:AH" & Fin)
End With
 
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(AA, 1)
    If AA(i, Col) <> "" Then
        If Not MonDico.Exists(AA(i, Col)) Then MonDico.Add AA(i, Col), AA(i, Col)
    End If
Next i
If MonDico.Count > 0 Then Cmb.List = Application.Transpose(MonDico.Items)
MonDico.RemoveAll
Set MonDico = Nothing
End Sub

24/04/2014, 14h11
casefayere

Citation:

Sinon Casefayere peux tu m'expliquer ce qui bloquait car je n'arrive pas à voir.

je pense à des mauvaises manipuilations de variables

Citation:

et tout marche bien si il y a quelque chose dans la colonne 5 sinon ca bug.

C'est pour ça, voyant ta colonne sans données, j'ai pensé que c'était 6 ou 7 ou.....

Maintenant, regardes la dernière intervention de mercatog
24/04/2014, 14h26
bboy-eazy

Merci beaucoup a vous deux.

A méditer sur ce code maintenant je vais m'employer pour comprendre la structure.

Bonne journée à tous les deux.
24/04/2014, 15h43
Docmarti
Bonjour bboy-eazy

Citation:

comment mettre une ligne dans ma listbox en première position pour avoir les titres? (Nom en colonne 1, Prénom en colonne 2 par exemple etc...

Il te faut mettre la propriété ColumnHeads du ListBox à Vrai.
Puis utiliser la propriété RowSource pour remplir le Listbox.

Si les titres sont sur la ligne 1 et les données sur ligne 2 et suivantes :
Code:

1 2 DerniereLigne = 6 L1.RowSource = "Feuil1!A2:C" & DerniereLigne
24/04/2014, 15h58
bboy-eazy

Merci Docmarti