Alternative à Sub ComboBox1_Change()

**eric4459** · 12/05/2016, 11h31

Bonjour j'ai crée un Userform avec 3 Combo-box.
La premier est chargée avec une liste de 15 éléments (des Pays)
La seconde est chargée à partir une liste de 135 éléments (des sociétés reparties dans ces 15 pays - en colonne D de ma liste les sociétés et en colonne E les pays associés)
Le but est de rechercher toutes les valeurs associées a une société dans un pays donné et qui alimenteront le Combo-Box3.
Le principe est le suivant:
L'utilisateur choisi un pays dans le premier Combo-box, comme je ne souhaite pas que l'utilisateur se farcisse la liste de toute les sociétés je les filtres en fonction du pays avec le code suivant qui s'active au changement de valeur du Combo-Box1.
Il est possible qu'aucune donnée ne soit associée a une société dans un pays donné.
Pour cela j'ai mis une conditions pour vérifier si il y a ou pas des données associées.
Mon problème est que comme je lance ma macro sur le changement de valeur du Combo-Box 1, si il n'y a pas de données un message s'affiche pour avertir l'utilisateur et je voudrais effacer la valeur qui ne retourne aucun résultat (La valeur du Combo-Box 1) repasse à vide, mais comme je suis dans une Sub Combo-Box_Change, c'est le chien qui se mort la queue

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
Sub ComboBox1_Change()
Dim Data As Worksheet     
Dim Reg As Worksheet
Dim Cy As Range
Dim Vendor_Ctry As Range
Dim nbline As Integer
Set Data = ThisWorkbook.Sheets("Data")
Set Reg = ThisWorkbook.Sheets("NOI_Reg")
Set Cy = Data.Range("G5")
Set Vendor_Ctry = Reg.Range("C3")
 
    With Reg
        nbline = .Cells(.Rows.Count, 1).End(xlUp).Row - 2 
    End With
 
 
For i = 0 To nbline
 
    If NOI_Selection.ComboBox1.Value = Vendor_Ctry.Offset(i, 0) Then
 
            If NOI_Selection.ComboBox1.Value = Cy.Offset(0, 0) Then
                NOI_Selection.ComboBox2.List = Data.Range("D5:D6").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(1, 0) Then
                NOI_Selection.ComboBox2.Value = Data.Range("D7").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(2, 0) Then
                NOI_Selection.ComboBox2.Value = Data.Range("D8").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(3, 0) Then
                NOI_Selection.ComboBox2.List = Data.Range("D9:D11").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(4, 0) Then
                NOI_Selection.ComboBox2.List = Data.Range("D12:D13").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(5, 0) Then
                NOI_Selection.ComboBox2.List = Data.Range("D14:D27").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(6, 0) Then
                NOI_Selection.ComboBox2.Value = Data.Range("D28").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(7, 0) Then
                NOI_Selection.ComboBox2.List = Data.Range("D29:D37").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(8, 0) Then
                NOI_Selection.ComboBox2.Value = Data.Range("D38").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(9, 0) Then
                NOI_Selection.ComboBox2.List = Data.Range("D39:D42").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(10, 0) Then
                NOI_Selection.ComboBox2.Value = Data.Range("D43").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(11, 0) Then
                NOI_Selection.ComboBox2.Value = Data.Range("D44").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(12, 0) Then
                NOI_Selection.ComboBox2.Value = Data.Range("D45").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(13, 0) Then
                NOI_Selection.ComboBox2.List = Data.Range("D46:D121").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(14, 0) Then
                NOI_Selection.ComboBox2.List = Data.Range("D122:D135").Value
                Exit Sub
            End If
    Else
 
    A = MsgBox(" No NOI associated with this Country", vbOKOnly + vbExclamation, WARNING)
         If A = vbOK Then
               Me.Hide
 
         End If
    End If
Next i
 
Me.Hide
 
End Sub

Mes question sont les suivantes:
Comment déclencher mon code sans passer par une sub ComboBox_Change ou alors comment gérer le cas qui me pose problème?
Comment mettre a jour la liste du ComboBox2 (les sociétés) de façon automatique car ici je me tape tout à la main si on ajoute une société dans un pays? (Je sais que mon code est une usine à gaz mais j'ai du le créer rapidement pour répondre a un besoin urgent et n'ai pas vraiment cherché d'autres solutions)
Nom : Liste Societe.jpg
Affichages : 1355
Taille : 197,4 Ko

Nom : Liste Societe.jpg
Affichages : 1355
Taille : 197,4 Ko

Merci pour vos conseils et votre aide
Eric

**jeanmidudu** · 12/05/2016, 11h37

Pour empêcher le ComboBox_Change() récursivement, il faut que tu utilises un booléen dedans qui :
- si vrai alors tu continues le ComboBox_Change()
- sinon, tu sors du ComboBox_Change()

Et pour éviter de tout te farcir à la main, pourquoi pas utiliser une boucle for?

**eric4459** · 12/05/2016, 12h54

Bonjour JeanMi
En fait je souhaite que des que je sélectionne une valeur dans ma ComboBox1 j'alimente aussitôt ma ComboBox2 avec une liste issue de mon code.
Quelle serait la syntaxe pour ta proposition car j'ai essayé

Code :

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

If NOI_Selection.ComboBox1.Change = True Then

mais j'ai une erreur Compil Error "Method or data member not found"
Et pour la mise a jour je ne vois pas comment je pourrais utiliser une boucle for car le nouveau pays ou la nouvelle société viendrai s’insérer dans ma liste existante décalant par la même mes references.

Par exemple si j'insere une ligne en D35 (voir copie d'écran plus du 1er message), je n'aurai plus

Code :

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

1
2
3
4
5
6
ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(7, 0) Then
                NOI_Selection.ComboBox2.List = Data.Range("D29:D37").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(8, 0) Then
                NOI_Selection.ComboBox2.Value = Data.Range("D38").Value
                Exit Sub

Mais

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(7, 0) Then
                NOI_Selection.ComboBox2.List = Data.Range("D29:D38").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(8, 0) Then
                NOI_Selection.ComboBox2.Value = Data.Range("D39").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(9, 0) Then
                NOI_Selection.ComboBox2.List = Data.Range("D40:D43").Value
                Exit Sub
            ElseIf NOI_Selection.ComboBox1.Value = Cy.Offset(10, 0) Then
                NOI_Selection.ComboBox2.Value = Data.Range("D44").Value
                Exit Sub

Eric

**pijaku** · 12/05/2016, 12h58

Bonjour,

Un petit exemple avec 2 combobox.
A adapter le nom de la feuille, ici Feuil1...

Dans un module standard :

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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
Option Explicit
 
    Public Function derlig_reelle(plage As Range) As Long
       'cas d'absence de données dans la plage à traiter :
       If WorksheetFunction.CountA(plage) = 0 Then derlig_reelle = 1: Exit Function
       'dans tous les autres cas :
       derlig_reelle = plage.Find("*", , , , , xlPrevious).Row
    End Function
 
    Public Function Filtre_Tableau(ByVal Tableau As Variant, _
                                         Colonne As Long, _
                                         Key1 As Variant, _
                                         Optional test As String = "=") As Variant
    'Filtre un tableau à 2 dimensions en fonction du contenu d'une colonne
    '
    '!!!!!!!!! utilise les fonctions : Nb_Dimensions & Transposition
    '
    'PARAMETRES
        'Tableau = Array de variant à 2 dimensions
        'Colonne = numéro de la colonne contenant les données à filtrer
        'Key1 = comparateur, donnée à laquelle comparer les données de la colonne Colonne
        'Test = opérateur parmi : "=", "<", "<=", ">", ">=", "Like", "<>" (à passer en String donc avec guillemets)
 
    Dim Tbl() As Variant, i As Long, j As Long, Cpt As Long, TestColonne As Variant
 
        On Error GoTo Erreur_Colonne
        TestColonne = Tableau(LBound(Tableau, 1), Colonne)
        On Error GoTo 0
        Select Case Nb_Dimensions(Tableau)
            Case 0
                MsgBox "Le tableau passé en paramètre est vide."
            Case 1
                MsgBox "Le tableau passé en paramètre ne comporte qu'une colonne. La fonction n'est pas adaptée à ce cas."
            Case 2
                Select Case test
                    Case "="
                        For i = LBound(Tableau, 1) To UBound(Tableau, 1)
                            If Tableau(i, Colonne) = Key1 Then
                                Cpt = Cpt + 1
                                ReDim Preserve Tbl(1 To UBound(Tableau, 2), 1 To Cpt)
                                For j = LBound(Tableau, 2) To UBound(Tableau, 2)
                                    Tbl(j, Cpt) = Tableau(i, j)
                                Next j
                            End If
                        Next i
                    Case "<"
                        For i = LBound(Tableau, 1) To UBound(Tableau, 1)
                            If Tableau(i, Colonne) < Key1 Then
                                Cpt = Cpt + 1
                                ReDim Preserve Tbl(1 To UBound(Tableau, 2), 1 To Cpt)
                                For j = LBound(Tableau, 2) To UBound(Tableau, 2)
                                    Tbl(j, Cpt) = Tableau(i, j)
                                Next j
                            End If
                        Next i
                    Case ">"
                        For i = LBound(Tableau, 1) To UBound(Tableau, 1)
                            If Tableau(i, Colonne) > Key1 Then
                                Cpt = Cpt + 1
                                ReDim Preserve Tbl(1 To UBound(Tableau, 2), 1 To Cpt)
                                For j = LBound(Tableau, 2) To UBound(Tableau, 2)
                                    Tbl(j, Cpt) = Tableau(i, j)
                                Next j
                            End If
                        Next i
                    Case "<="
                        For i = LBound(Tableau, 1) To UBound(Tableau, 1)
                            If Tableau(i, Colonne) <= Key1 Then
                                Cpt = Cpt + 1
                                ReDim Preserve Tbl(1 To UBound(Tableau, 2), 1 To Cpt)
                                For j = LBound(Tableau, 2) To UBound(Tableau, 2)
                                    Tbl(j, Cpt) = Tableau(i, j)
                                Next j
                            End If
                        Next i
                    Case ">="
                        For i = LBound(Tableau, 1) To UBound(Tableau, 1)
                            If Tableau(i, Colonne) >= Key1 Then
                                Cpt = Cpt + 1
                                ReDim Preserve Tbl(1 To UBound(Tableau, 2), 1 To Cpt)
                                For j = LBound(Tableau, 2) To UBound(Tableau, 2)
                                    Tbl(j, Cpt) = Tableau(i, j)
                                Next j
                            End If
                        Next i
                    Case "<>"
                        For i = LBound(Tableau, 1) To UBound(Tableau, 1)
                            If Tableau(i, Colonne) <> Key1 Then
                                Cpt = Cpt + 1
                                ReDim Preserve Tbl(1 To UBound(Tableau, 2), 1 To Cpt)
                                For j = LBound(Tableau, 2) To UBound(Tableau, 2)
                                    Tbl(j, Cpt) = Tableau(i, j)
                                Next j
                            End If
                        Next i
                    Case "Like"
                        For i = LBound(Tableau, 1) To UBound(Tableau, 1)
                            If Tableau(i, Colonne) Like Key1 Then
                                Cpt = Cpt + 1
                                ReDim Preserve Tbl(1 To UBound(Tableau, 2), 1 To Cpt)
                                For j = LBound(Tableau, 2) To UBound(Tableau, 2)
                                    Tbl(j, Cpt) = Tableau(i, j)
                                Next j
                            End If
                        Next i
                    Case Else
                        MsgBox "Le paramètre facultatif Test est erroné."
                        Exit Function
                End Select
                On Error GoTo resultat_Vide
                TestColonne = Tbl(UBound(Tbl, 1), UBound(Tbl, 2))
                On Error GoTo 0
                Filtre_Tableau = Transposition(Tbl)
                Erase Tbl
            Case Else
                MsgBox "Le tableau comporte plus de deux dimensions. La fonction n'est pas adaptée à ce cas."
        End Select
        Exit Function
Erreur_Colonne:
    MsgBox "Le paramètre Colonne est erroné."
    Exit Function
resultat_Vide:
    MsgBox "Le filtre renvoie un tableau vide de données."
    End Function
 
    Public Function Nb_Dimensions(Tableau As Variant) As Integer
    'Calcule le nombre de dimensions d'un tableau
    'PARAMETRE
        'Tableau = Array de Variant à 0, 1 ou plusieurs dimensions
    Dim D As Integer, t As Integer
 
        On Error GoTo Fin
        Do: D = D + 1: t = UBound(Tableau, D): Loop
Fin:
    Nb_Dimensions = D - 1
    End Function
 
    Public Function Range_To_Tb(plage As Range) As Variant()
    'Converti sans faille un range en tableau
 
    '
    '   Le tableau ainsi obtenu est toujours en option base 1
    '   ET à 2 dimensions
    'PARAMETRE
        'plage = Range (plage de cellule(s))
 
        If plage.Cells.Count < 2 Then
           Dim tablo(1 To 1, 1 To 1)
           tablo(1, 1) = plage.Value
           Range_To_Tb = tablo
           Erase tablo
         Else
           Range_To_Tb = plage.Value
         End If
    End Function
 
    Public Function Transposition(ByRef Tableau As Variant) As Variant
    'Transpose, en lignes, un tableau à 2 dimensions de plus de 65536 Colonnes
    '
    '!!!!!!!!! utilise la fonction : Nb_Dimensions
    '
    'PARAMETRE
        'Tableau = Array de Variant à 2 dimensions
 
        Select Case Nb_Dimensions(Tableau)
            Case 0
                MsgBox "Le tableau passé en paramètre est vide."
            Case 1
                MsgBox "Le tableau passé en paramètre ne comporte qu'une colonne. La fonction n'est pas adaptée à ce cas."
            Case 2
                Dim Tabl, i As Long, j As Long
                ReDim Tabl(1 To UBound(Tableau, 2), 1 To UBound(Tableau, 1))
                For i = LBound(Tableau, 1) To UBound(Tableau, 1)
                    For j = LBound(Tableau, 2) To UBound(Tableau, 2)
                        Tabl(j, i) = Tableau(i, j)
                    Next j
                Next i
                Transposition = Tabl
                Erase Tabl
            Case Else
                MsgBox "Le tableau comporte plus de deux dimensions. La fonction n'est pas adaptée à ce cas."
        End Select
    End Function

Dans le module 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
Option Explicit
 
 
Private Sub UserForm_Initialize()
Dim DL As Long, L As Long
    With Worksheets("Feuil1")
        DL = derlig_reelle(.Columns(5))
        For L = 2 To DL
            ComboBox1.Value = .Cells(L, 5)
            If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem .Cells(L, 5)
        Next
    End With
    'empêche la saisie de valeurs farfelues dans ta combo
    ComboBox1.Style = fmStyleDropDownList
    ComboBox1.ListIndex = -1
End Sub
 
 
Private Sub ComboBox1_Click()
    If ComboBox1 = "" Then Exit Sub
    Dim Donnees, DL As Long
    With Worksheets("Feuil1")
        DL = derlig_reelle(.Columns(5))
        Donnees = .Range("D2:E" & DL)
    End With
    ComboBox2.List = Filtre_Tableau(Donnees, 2, ComboBox1.Value, "=")
End Sub

Un fichier exemple :
Pièce jointe 209494

**eric4459** · 12/05/2016, 15h07

Bonjour Franck,
Merci pour ce code qui fonctionne super bien dans ton exemple mais je ne suis pas parvenu à l'adapter à mon cas.
J'ai modifié ceci

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
Private Sub Open_NOI_Selection()
Dim DL As Long, L As Long
    With Worksheets("Data")
        DL = derlig_reelle(.Columns(5))
        For L = 5 To DL
            ComboBox1.Value = .Cells(L, 5)
            If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem .Cells(L, 5)
        Next
    End With
    'empêche la saisie de valeurs farfelues dans ta combo
    ComboBox1.Style = fmStyleDropDownList
    ComboBox1.ListIndex = -1
End Sub
 
 
Private Sub ComboBox1_Click()
    If ComboBox1 = "" Then Exit Sub
    Dim Donnees, DL As Long
    With Worksheets("Data")
        DL = derlig_reelle(.Columns(5))
        Donnees = .Range("D5:E" & DL) 'Ma liste commence en D5
    End With
    ComboBox2.List = Filtre_Tableau(Donnees, 2, ComboBox1.Value, "=")
End Sub

Quand l'UserForm s'ouvre, (je n'ai pas vu quelle est la commande pour l'ouvrir dans ton code -moi j'utilise UserForm1.Show), la liste est vide, j'ai du rater quelque-chose mais ce code est un peu trop complexe pour moi sans l'avoir étudié longuement.
Eric

**Docmarti** · 12/05/2016, 15h45

Bonjour Eric

Voici une autre suggestion.

**eric4459** · 12/05/2016, 15h59

Bonjour Doc Marti,
Merci pour ton aide, ce type de code est un peu plus à ma portée que celui de Franck, que je remercie tout de même également.
Je vais donc adapter cela à mon contexte et je reviendrai poster ce que j'aurai fait, ou reviendrai vous voir si j'ai d'autres soucis

Eric

Alternative à Sub ComboBox1_Change()

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager