Excel VBA Comment désactiver un item dans une Combobox ?

Version imprimable

22/05/2021, 09h56
patmicro

1 pièce(s) jointe(s)

Excel VBA Comment désactiver un item dans une Combobox ?

Bonjour à tous les lecteurs.

Excel VBA Comment désactiver un item dans une combobox?

Dans une Combobox j'aimerais rendre non cliquable un item que j'aurais préalablement désactivé dans une feuille contenant les données à charger et rendre cet Item visible mais grisé (donc non cliquable) de la même manière que les logiciels spécialisés.
Je ne suis qu'un simple amateur et je n'ai aucune idée de la construction de ce code.
Par avance je vous remercie pour votre aide.

Bonjour

Google est ton ami.

Je n'ai pas trouvé comment griser un item par contre on peut renvoyer un message de non validité de la donnée dans le contexte

Sinon on peut recharger le controle Combobox1 en l'effaçant et en chargeant les seuls items cliquables

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Dim boolC As Boolean
 
 
Private Sub UserForm_Initialize()
    Dim arrServices()
   arrServices()= Array("Achats","Commercial","Maintenance","Informatique","Ressources humaines","Comptabilité","Environnement","Qualité")
    For i = 1 To 10
        ComboBox1.AddItem i
    Next i
End Sub
 
'Cela empêchera de sélectionner les items de arrServices de rang 1, 2, 3 soit "Commercial","Maintenance" et "Informatique"
Private Sub ComboBox1_Change()
    If Not boolC Then
        boolC = True
        Select Case ComboBox1.ListIndex
            Case 1, 2, 3: ComboBox1.ListIndex = 0
        End Select
        boolC = False
    End If
End Sub

Bonjour fraflt69 : Merci d'avoir pris le temp de répondre à ma question.

Je ne vois pas à quel endroit je dois inserer le code que vous m'avez fournis

Lorsque je le met en en-tête de mon code dans la combo je ne vois qu'une liste de numéros de 1 à 10 alors que je devrais voir ma liste.

Je joint une partie de mon code pour plus de clarté.

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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
 
'***********************************************************
'Procédure permettant de charger la liste des Fonctions"
'Dans La 1ére liste déroulante au chargement du formulaire
''''''''''''''''''''''''''''''''''''''''''''''''''''''''****
 
'Déclaration des variables
Dim Colonne As Integer
Dim i As Integer, J As Integer
Dim Criteres2 As Integer
 
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
AfficheFeuilles
 
    'Initalisation des variables
    Colonne = 56 'Affectation du numéro de colonne à 56 car la première donnée en colonne BD
    'On efface la couleur de remplissage des en-têtes de colonnes, ici les noms des "Fonctions"
    Sheets("Liste").Select
    'Range("BB2:BF2").Select '.interiorcolorindex = Clear
    Sheets("Liste").Range("BD2:BH2").Interior.ColorIndex = Clear
    'On réalise une boucle qui vas charger les noms des "Fonctions dans la liste déroulante.
    Do While Cells(2, Colonne).Value <> "" 'Tant qu'il y a des valeurs dans la ligne 2, on charge les noms jusqu'a rencontrer une cellule vide
 
        frmSélection.cboType2.AddItem Cells(2, Colonne).Value
        Colonne = Colonne + 1 'On Incrémente le numéro de colonne afin de passer à la colonne de droite.
 
    Loop
'MasqueFeuilles
End Sub
 
'*******************************************************************************
'Procédure permettant de charger la liste déroulante
'de la "Sélection correspondante au choix effectué dans la liste des Fonctions
'*******************************************************************************
 
Private Sub cboType2_change()
 
AfficheFeuilles
 
    'Initalisation des variables
    i = 56 '= 56 ème Colonne
    'On vide la liste déroulante des villes afin de ne pas cumuler les enregistrements
     frmSélection.cboCriteres2.Clear
    'On retire les couleurs de remplissage des en-têtes
    Sheets("liste").Range("BD2:BH2").Interior.ColorIndex = Clear
 
    'On boucle pour récupérer chacune des Sélection de la Fonction sélectionnée
    Do While Cells(2, i).Value <> ""
        'On test que le nom de la Fonction dans la liste déroulante soit indentique à la cellule active
        If Cells(2, i).Value = cboType2.Value Then 'Si oui
 
            'On sélectionne la cellule de la Fonction
            Cells(2, i).Select
            'On y ajoute une couleur de remplissage
            ActiveCell.Interior.ColorIndex = 22 'On color la cellule de la colonne concernée
            'On récupère son positionnement par le n° de colonne
            Colonne = ActiveCell.Column ' ok jusqu' ici
        End If
    i = i + 1 'On incrémente le numéro de colonne
    Loop
    'On initialise à 3 le numéro de ligne, la 1ére Sélection se trouve en ligne 3
    J = 3
    'On boucle les lignes pour récupérer les noms des villes
    Do While Cells(J, Colonne).Value <> ""
        'On charge les villes dans la liste déroulante des villes.
        frmSélection.cboCriteres2.AddItem Cells(J, Colonne)
        J = J + 1 'On incrémente le numéro de ligne.
    Loop
    'On affiche la première valeur par défaut
     cboCriteres2.ListIndex = 0
MasqueFeuilles
End Sub
 
 
 
Private Sub btnValider_Click()
    shListe.Activate
        frmSélection.cboCriteres2 = cboCriteres2.Value
            Worksheets("Liste").Range("BL2").Value = cboCriteres2.Value
                Unload Me
'********************************
'Liste des Statuts
'********************************
 
    If shListe.Range("BL2") = "Agent" Then
    shMenu.Select
        Affiche_Agent
    Else
 
    If shListe.Range("BL2") = "Cadre" Then
    shMenu.Select
        Affiche_Cadre
    Else
 
'********************************
'Liste des Contrats
'********************************
 
    If shListe.Range("BL2") = "CDI" Then
    shMenu.Select
        Affiche_CDI
    Else
 
    If shListe.Range("BL2") = "CDD" Then
    shMenu.Select
        Affiche_CDD
    Else
 
    If shListe.Range("BL2") = "INTERIMAIRE" Then
    shMenu.Select
        Affiche_Intérimaires
    Else
 
    If shListe.Range("BL2") = "STAGIAIRE" Then
    shMenu.Select
        Affiche_Stagiaires
    Else
 
    If shListe.Range("BL2") = "TEMPS PARTIEL" Then
    shMenu.Select
        Affiche_Temps_partiel
    Else
 
    If shListe.Range("BL2") = "ALTERNANCE" Then
    shMenu.Select
        Affiche_Alternance
    Else
 
'********************************
'Liste des Services
'********************************
 
    If shListe.Range("BL2") = "Achat" Then
    shMenu.Select
        Affiche_Achats
    Else
 
    If shListe.Range("BL2") = "Commercial" Then
    shMenu.Select
        Affiche_Commercial
    Else
 
    If shListe.Range("BL2") = "Maintenance" Then
    shMenu.Select
        Affiche_Maintenance
    Else
 End if x fois
 'je n'ai pas mis la totalité du code

3 pièce(s) jointe(s)

hello,
voici une solution possible en utilisant une combobox multicolonnes
Dans une feuille du classeur définir une plage nommée qui contient les colonnes de la combobox :
exemple :

Pièce jointe 598413

Les cellules de la colonne Actif contiennent un X si le service est disponible.

En pièce jointe l'export du formulaire exemple dont voici le code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Dim OldIndex As Integer Private Sub ComboBox1_Click() 'si service non actif on garde l'ancienne valeur de la Combo If ComboBox1.Column(1) = "" Then ComboBox1.ListIndex = OldIndex End Sub Private Sub ComboBox1_DropButtonClick() 'On mémorise l'ancienne valeur de la combo sur appui sur bouton Combo OldIndex = ComboBox1.ListIndex End Sub Private Sub UserForm_Initialize() ComboBox1.ColumnCount = 2 Dim varServices As Variant varServices = ThisWorkbook.Worksheets("Services").Range("Services") ComboBox1.List = varServices End Sub
Voici le résultat :

Pièce jointe 598414

Ami calmant, J.P

25/05/2021, 17h01
patmicro

Bonjour jurassic pork : Merci pour votre participation.

Je suis ok pour votre principe , mais après de multiple tentatives c'est un échec.

Je joint le fichier de démo pour essayer de vous expliquer ma demande (je sais ce n'est pas recommandé de déposer des fichiers) j'espère que vous me pardonnerez.

https://www.cjoint.com/c/KEzo6RgjtUp

je aimerais savoir comment vous avez fait votre animation ?

Par avance je vous remercie.

2 pièce(s) jointe(s)

hello,
j'ai apporté différentes améliorations à ton code :
- Utilisation d'une plage nommée pour remplir la comboBox de fonctions
- Utilisation d'un Select Case plutôt qu'une série de Else
et j'ai implémenté l'élément de la comboBox désactivé ( comboBox à 2 colonnes)
Le principe:
Quand on sélectionne une fonction l'entête devient vert. Si il y a des éléments en rouge dans la colonne correspondante pendant la construction de la comboBox de critères , il n' y a pas de X mis en deuxième colonne.
Voici le code :

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
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
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
'***********************************************************
'Procédure permettant de charger la liste des Fonctions"
'Dans La 1ére liste déroulante au chargement du formulaire
''''''''''''''''''''''''''''''''''''''''''''''''''''''''****
 
 
'Déclaration des variables
Dim Colonne As Integer
Dim i As Integer, J As Integer
Dim Criteres2 As Integer
Dim shMenu, shListe As Worksheet
Dim OldIndex As Integer
 
 
 
 
 
 
Private Sub cboCriteres2_Click()
'Si critère non actif on garde l'ancienne valeur de la ComboBox
If cboCriteres2.Column(1) = "" Then cboCriteres2.ListIndex = OldIndex
End Sub
 
 
Private Sub cboCriteres2_DropButtonClick()
'On mémorise l'ancienne valeur de la comboBox sur appui sur bouton ComboBox
OldIndex = cboCriteres2.ListIndex
End Sub
 
 
Private Sub UserForm_Initialize()
Dim varFonctions As Variant
'On utilise la plage nommée Fonctions pour charger la Combobox Fonction
varFonctions = Sheets("Liste").Range("Fonctions")
'On utilise Transpose car la plage nommée est sur une ligne (pas en colonne)
frmSélection.cboType2.List = Application.WorksheetFunction.Transpose(varFonctions)
Set shListe = Sheets("Liste")
'Set shMenu = Sheets("Menu")
End Sub
 
 
'*******************************************************************************
'Procédure permettant de charger la liste déroulante
'de la "Sélection correspondante au choix effectué dans la liste des Fonctions
'*******************************************************************************
 
 
Private Sub cboType2_change()
  frmSélection.cboCriteres2.Clear
    'Initalisation des variables
    i = 3
    'On retire les couleurs de remplissage des en-têtes
    shListe.Range("C2:GI2").Interior.ColorIndex = Clear
 
    'On boucle pour récupérer chacune des Sélection de la Fonction sélectionnée
    Do While Cells(2, i).Value <> ""
        'On teste que le nom de la Fonction dans la liste déroulante soit indentique à la cellule active
        If Cells(2, i).Value = cboType2.Value Then 'Si oui
 
            'On sélectionne la cellule de la Fonction
            Cells(2, i).Select
            'On y ajoute une couleur de remplissage
            ActiveCell.Interior.ColorIndex = 35 'On colore la cellule de la colonne concernée
            'On récupère son positionnement par le n° de colonne
            Colonne = ActiveCell.Column ' ok jusqu' ici
        End If
    i = i + 1 'On incrémente le numéro de colonne
    Loop
    '
    J = 0
    'On boucle les lignes pour récupérer les noms
    Do While Cells(J + 3, Colonne).Value <> ""
       'On ajoute un élément à la ComboBox cboCritere2
       frmSélection.cboCriteres2.AddItem
       'On ajoute en première colonne le nom
       frmSélection.cboCriteres2.List(J, 0) = Cells(J + 3, Colonne)
       'Si la cellule n'est pas rouge on ajoute un X en deuxième colonne
       'Sinon on ne met rien dans la deuxième colonne de la Combo
       If Cells(J + 3, Colonne).Interior.ColorIndex <> 3 Then
           frmSélection.cboCriteres2.List(J, 1) = "X"
       Else
           frmSélection.cboCriteres2.List(J, 1) = ""
       End If
        J = J + 1 'On incrémente le numéro de ligne.
    Loop
 
    'On affiche la première valeur par défaut
     cboCriteres2.ListIndex = 0
End Sub
 
Private Sub btnValider_Click()
shListe.Activate
frmSélection.cboCriteres2 = cboCriteres2.Value
shListe.Range("BL2").Value = cboCriteres2.Value
'********************************
'Liste des Statuts
'********************************
Select Case shListe.Range("BL2")
    Case "Agent"
        'shMenu.Select
        'Affiche_Agent
    Case "Cadre"
        'shMenu.Select
        'Affiche_Cadre
'********************************
'Liste des Contrats
'********************************
    Case "CDI"
        'shMenu.Select
        'Affiche_CDI
 
 
    Case "CDD"
        'shMenu.Select
        'Affiche_CDD
    Case "INTERIMAIRE"
        'shMenu.Select
        'Affiche_Intérimaires
    Case "STAGIAIRE"
        'shMenu.Select
        'Affiche_Stagiaires
    Case "TEMPS PARTIEL"
        'shMenu.Select
        'Affiche_Temps_partiel
    Case "ALTERNANCE"
        'shMenu.Select
        'Affiche_Alternance
'********************************
'Liste des Services
'********************************
 
    Case "Achat"
        'shMenu.Select
        'Affiche_Achats
    Case "Commercial"
        'shMenu.Select
        'Affiche_Commercial
    Case "Maintenance"
        'shMenu.Select
        'Affiche_Maintenance
    Case "Informatique"
        'shMenu.Select
        'Affiche_Informatique
    Case "Ressources Humaines"
        'shMenu.Select
        'Affiche_RH
    Case "Comptabilité"
        'shMenu.Select
        'Affiche_Comptabilité
    Case "Environnement"
        'shMenu.Select
        'Affiche_Environnement
    Case "Qualité"
        'shMenu.Select
        'Affiche_Qualité
    Case "Production"
        'shMenu.Select
        'Affiche_Production
 
    'Case "ListeSalariés"
    '    'shMenu.Select
        'ListeSalarié
 
'********************************
'Liste des Echelons
'********************************
    Case "1"
        'shMenu.Select
        'Affiche_Echelon_1
    Case "2"
        'shMenu.Select
        'Affiche_Echelon_2
    Case "3"
        'shMenu.Select
        'Affiche_Echelon_3
    Case "4"
        'shMenu.Select
        'Affiche_Echelon_4
    Case "5"
        'shMenu.Select
        'Affiche_Echelon_5
    Case "6"
        'shMenu.Select
        'Affiche_Echelon_6
    Case "7"
        'shMenu.Select
        'Affiche_Echelon_7
    Case "8"
        'shMenu.Select
        'Affiche_Echelon_8
    Case "9"
        'shMenu.Select
        'Affiche_Echelon_9
'********************************
'Liste des Genres
'********************************
 
    Case "Homme"
        'shMenu.Select
        'Affiche_Homme
    Case "Femme"
        'shMenu.Select
        'Affiche_Femme
 
'********************************
'Liste des Images Vides
'********************************
    Case "Image Vide"
        'Affiche_Image_Vide 'Déclenche la macro
 
 
    'Case "X"
    '    'shMenu.Select
        ''Affiche_Image_non_Vide 'Déclenche la macro
    Case Else
        'code si aucune des conditions précédentes n'est remplie
End Select
Unload Me
End Sub
 
'Procédure permettant de fermer le formulaire.
Private Sub btnFermer_Click()
    Unload Me
End Sub

Le fichier excel correspondant est en pièce jointe.

Et voici le résultat :

Pièce jointe 598579

Le logiciel utilisé pour faire l'animation est Licecap

Ami calmant, J.P

Bonjour jurassic pork : Un très grand merci pour de code fournis. J'ai réussis à l'adapter à mon fichier. c'est super.

Questions supplémentaires:

Le petit soucis est il possible de ne pas déclencher la macro lorsque par ex Désignation Qualité ou Informatique ou autre sont désactivées puisque par défaut c'est la dernière utilisée qui s'affiche par défaut ?
Pour résumer Si la cellule sélectionnée n'est pas Rouge donc avec un X dans la cboCrtitères2 alors on affiche le résultat en cellule "BL2" / sinon Si la cellule sélectionnée est Rouge donc sans X dans la cboCrtitères2 alors on affiche le résultat en cellule "BM2"

J'ai ajouté un coloriage en rouge par double click pour plus de facilité.
Est il possible de limiter ce double click seulement au cellules du tableau ?

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
 
 'Colorer cellule par double click
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 3 Or Target.Column = 4 Or Target.Column = 5 Or Target.Column = 6 Or Target.Column = 7 Or Target.Column = 8 Then ' Or Target.Column = 51 Or Target.Column = 59 Or Target.Column = 67 Or Target.Column = 75 Or Target.Column = 83 Or Target.Column = 91 Then
        If Target.Interior.Pattern <> xlNone Then
            Target.Interior.Pattern = xlNone
        Else
            Select Case Target.Column
            Case 3  'colonne C
         'Range("C3:C4").Activate
                'Target.Interior.Color = 49407 ce code est remplacé par le code ci-dessous
            With Selection.Interior
                 .Color = RGB(255, 0, 0)
            End With
            Case 4 'colonne D
                'Target.Interior.Color = 49407
                With Selection.Interior
                 .Color = RGB(255, 0, 0)
            End With
            Case 5 'colonne E
                'Target.Interior.Color = 49407
                With Selection.Interior
                 .Color = RGB(255, 0, 0)
            End With
            Case 6 'colonne F
                'Target.Interior.Color = 49407
                With Selection.Interior
                 .Color = RGB(255, 0, 0)
            End With
            Case 7 'colonne G
                'Target.Interior.Color = 49407
                With Selection.Interior
                 .Color = RGB(255, 0, 0)
            End With
            Case 8 'colonne H
                'Target.Interior.Color = 49407
                With Selection.Interior
                 .Color = RGB(255, 0, 0)
            End With
 
            End Select
        End If
 Cancel = True ' ici mettre éventuellement pour effacer par un double clic
    End If
End Sub

Par avance je vous remercie.