Liste déroulante colorée (sans Mise en Forme Conditionnelle)
Bonjour à tous,
J’ai besoin de votre aide svp 😊
Je suis en train de mettre un planning en place pour me permettre de déterminer combien de salarié seront nécessaires sur chaque poste par semaine.
Voici ci-joint un exemple avec le poste « Gardien ». J’ai déjà un petit code VBA permettant en fonction de la couleur de la cellule de déterminer le nombre de ces cellules colorées (soit le nombre d’heure) pour chaque salarié (ex = il y a 6 couleurs différentes = 6 salariés). Ce code marche très bien, et pour m’y retrouver, je numérote toutes les cellules pour m’assurer de ne pas en mettre plus de 8h par jour.
Puisque la couleur est importante pour ce code, je voudrais que chaque cellule de ce planning dispose d’une liste déroulante proposant ces 6 couleurs. De plus, à nouveau pour m’y retrouver, je voudrais pouvoir les numéroter manuellement pour m’assurer de ne pas mettre trop d’heure sur chaque jour.
Suis-je claire ? Sinon, n’hésitez pas à me demander 😊
Merci beaucoup :D !
Bonne journée à tous
MJ
Personne n'aurait une idée ?
Bonjour gmb,
Merci beaucoup de ton retour. C'est vraiment pas mal, mais :
1/ N'est-il pas possible d'utiliser la liste déroulante classique ? Car "double clic dans toutes les cellules + choisir une couleur" ça va être trop long à la longue
2/ Je ne peux plus rafraichir "double cliquer" dans mes cellules totales ? Car le résultat ne ce mets pas en temps réel, il faut rafraichir la formule à chaque fois.
Merci
Pour info, je ne peux pas passer par la mise en forme conditionnelle ... Lorsque j'écris dans la cellule, je perds la couleur car la cellule n'est plus égale à la valeur mentionnée dans la règle de MFC.
Super merci beaucoup
Qu'il y a t'il de nouveau à part que les cellules de couleur n'ont plus de formule ?
Je suis désolée si je ne suis pas claire
Merci gmb
Toutes mes excuses, je ne t'ai pas indiqué le mode d'emploi : au lieu d'un double clic dans une cellule, qui rendait le changement de couleur cellule par cellule, j'ai maintenant opté pour un clic droit.
Tu sélectionnes une plage de cellules (ou une seule cellule) puis tu fais un clic droit et la boite de dialogue s'ouvre. Après validation, le nombre de couleurs se met à jour sans besoin de formules.
OK ?
Bye !
C'est super cool gmb ! Trop hâte de le tester pour de vrai demain
Un dernier petit service STP pour rendre le fichier encore plus cool. Je vais avoir plus d'une 10ène d'onglets différents pour chaque poste. J'aurais voulu programmer plus ou moins de couleur par onglet.
Pour retirer une couleur c'est super facile. Mais pour en rajouter une ... plus complexe
'code sur l'onglet :
Option Explicit
Dim plage As Range, Sel As Range, cell As Range
Dim j&
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Set plage = Range("D20:Q" & Range("C" & Rows.Count).End(xlUp).Row) 'ça c'est ma plage, donc si j'ai plus ou moins de colonnes je change Q en R ... et etc ...
Range("C15:H15").ClearContents 'ça c'est la ligne qui totalise les couleurs, je change H en I ... et etc... pour toutes les couleurs que je vais rajouter
Set Sel = Intersect(plage, Selection)
If Not Sel Is Nothing Then
Sel.Select
UserForm1.Show
End If
Cancel = True
For Each cell In plage
For j = 3 To 8 'Je ne suis pas sure, il y a 8 couleurs en tout, est-ce que 8 doit être changé si j'en rajouter une ? ... 9 et etc ...
If cell.Interior.ColorIndex = Cells(15, j).Interior.ColorIndex Then 'ça c'est la ligne qui totalise les couleurs : "J" pour déterminer la fin de cette ligne ? ou rien à voir ?
Cells(15, j) = Cells(15, j) + 1
Exit For
End If
Next j
Next cell
End Sub'code sur USF :
Option Explicit
Dim couleur, Sel As Range, cell As Range
Private Sub CommandButton1_Click()
If ListBox1.ListIndex >= 0 And ListBox1.ListIndex < 7 Then 'nombre de ListBox, donc si nouvelle couleur = 8 ... et etc ...
For Each cell In Sel
cell.Interior.ColorIndex = couleur
cell.Interior.Pattern = xlSolid
Next cell
ElseIf ListBox1.ListIndex = 7 Then 'nombre de ListBox, donc si nouvelle couleur = 8 ... et etc ...
For Each cell In Sel
cell.Interior.ColorIndex = -4142
With cell.Interior
.Pattern = xlLightUp
End With
Next cell
End If
Unload Me
End Sub
Private Sub ListBox1_Click()
If ListBox1.ListIndex = 0 Then
Label2.BackColor = &HC0FFC0
couleur = 35
ElseIf ListBox1.ListIndex = 1 Then
Label2.BackColor = &HC0FFFF
couleur = 19
ElseIf ListBox1.ListIndex = 2 Then
Label2.BackColor = &HC0C0FF
couleur = 40
ElseIf ListBox1.ListIndex = 3 Then
Label2.BackColor = &HFFFFC0
couleur = 20
ElseIf ListBox1.ListIndex = 4 Then
Label2.BackColor = &HE0E0E0
couleur = 15
ElseIf ListBox1.ListIndex = 5 Then
Label2.BackColor = &HFFFF00
couleur = 33
ElseIf ListBox1.ListIndex = 6 Then
Label2.BackColor = &HFFFFFF
couleur = -4142
ElseIf ListBox1.ListIndex = 7 Then
Label2.BackColor = &HE0E0E0
Label2.Caption = "//////////"
ElseIf ListBox1.ListIndex = 8 Then
Label2.BackColor = &HFFFF00 'Qu'est-ce que c'est que TOUS ces codes ?? &HFFFF00 ??
couleur = 7 'pour du rose
End If
End Sub
Private Sub UserForm_initialize()
ListBox1.List = Range("B19:B26").Value 'B27 et etc pour toutes les couleurs écrites derrière le cadre blanc colonne B qui vont apparaitre dans la liste déroulante
Set Sel = Selection
End Subgmb, ton code correspond exactement à ce qui m'intéresse ! C'est TOP ! J'espère juste pouvoir le dompter au quotidien
Qu'est ce qu'il me manque ? Peux-tu s'il te plait écrire avec une autre couleur sur ton code que j'ai copié et me dire ce que j'ai loupé ?
Un grandgrandgrandgrand merciiiiiiiii
Bonjour
Nouvelle version avec une couleur de plus et quelques explications.
Bye !
Salut gmb,
Excuse moi stp de ne pas être revenu vers toi plus tôt.
Je suis à ma 3ème tentative et je n'arrive pas du tout à reproduire ton code
Je suis obligée d'abandonner ce fichier et je vais acheter un logiciel de planning.
Je te remercie néanmoins, ton fichier est vraiment génial (lorsqu'on s'y connait plus que moi
Bon week-end !
MJ
Bonjour Mjulie, Gmb,
En retour ton fichier modifié avec une note en rouge pour explications.
Une macro ci-dessous a été ajouté au projet VBA.
'Macro ajoutée en feuille FP-Gardien
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D20:Q43")) Is Nothing Then
Adr = Target.Address
'Au cas ou lettre absente du tableau couleur
On Error GoTo ErrAdr
Application.EnableEvents = False
'L'initiale de la couleur
Range("D11") = UCase(Left(Target, 1))
'La couleur cible
If Selection.Count > 1 Then
Selection.Interior.Color = Range([C11]).Interior.Color
Else: ActiveCell.Offset(-1, 0).Interior.Color = Range([C11]).Interior.Color
End If
Range(Adr) = Right(Target, 1)
Application.EnableEvents = True
End If
End
ErrAdr:
Application.EnableEvents = True
End SubEn espérant avoir simplifié ton besoin et t'éviter quelques frais.
Bonjour mjulie, gmb, X Cellus, bonjour le forum,
Effectivement, et avant de jeter à la poubelle votre classeur, veuillez regarder celui qui accompagne ce post, avec une version un peu différente de mes camarades à savoir l'utilisation d'une "palette" faite de shapes (formes - tout est paramétrable) qui apparaît au clic droit, puis permet de choisir une couleur et de l'appliquer à la ou les cellules sélectionnées.
Un petit exemple avec une image animée :
Comme vous semblez avoir une difficulté à dupliquer les macros sur d'autres feuilles ; je me suis permis d'ajouter une feuille avec quelques consignes supplémentaires pour y arriver sans trop de problèmes (enfin je crois)
Voici mon travail, j'espère que celui-ci collera à votre demande ?
Cordialement.
AL 22