[XL-2007] récuper le format (couleur,) dans une liste/data validation depuis la name Box [Résolu]

[duboisgs]

Bonjour à tous,
je souhaite récupérer le format (couleur de fond,....) d'un name box et ce dans le menu déroulant d'une Data Valadation.

Ce que je cherche, ce n'est pas les "Conditional formatting"
Est-ce possible sans macro?

Dans mon fichier, j'utilise également des data validation récupérant la valeur d'autre data validation (fonction : INDIRECT).
Je souhaite donc répéter cet exploi sur plusieurs cellules/data validation/List



Voir fichier joint.
Le premier onglet complet l'ensemble des champs avec name box
Le deuxième onglet comprend les datas validation.
Je souhaite par ex. en C11 que le menu déroulant (de la name box: Mini_reflectors) reprenne les couleurs de fond à savoir :
jaune pour 1988
rouge pour "Empty_head)


Merci d'avance pour votre aide

[White Mibu]

Bonjour,

je sais pas si j'ai bien compris ce que tu voulais... Fichier joint ce que j'ai compris !

Pour définir la couleur de remplissage avec des conditions utilise :

Accueil, Mise en forme conditionnelle et Gérer les règles...

[duboisgs]

Désolé, si je ne me suis pas correctement exprimé!

Ce souhaite que
les choix proposés et
le fromattage (couleur de font) dans la drop down list (Data validation)
soient en lien avec la zone de champ.



Pour mieux comprendre, j'ai mis un jpg.
il faudrait y remplacer pour
le choix 1988 le bleu de font par du jaune
le chois Empty_head en rouge.
Ces deux couleurs venant du champ "Mini_reflectors" de l'onglet "Global Synoptic"


Dans mon exemple, il faut choisir en C5 = Mini de sorte à avoir la bonne drop down liste

Je te remercies d'avance pour tes commentaires.
Duboisgs

[White Mibu]

Ok tu veut mettre la couleur de remplissage directement dans le menu déroulant ?

A ma connaissance c'est impossible... désolé

Le mieux que j'puisse faire pour t'aider, regarde fichier joint. Mais je pense pas que tu puisse mettre des couleurs dans le menu déroulant...

Bonne chance !

[duboisgs]

C'est bien le but que je cherche.
Mais l'emploi de format conditionnel ne répond pas à mais attente.
J'ai beaucoup trops de choix conditionnels dans mes champs.
Qui plus est, ceux-ci peuvent évoluer dans le temps. Et donc nécessite une addaptation des choix conditionnels.

A défaut d'avoir la couleur dans le menu déroulant, je suis parti sur une autre solution:
Je cherche à mettre la cellule en couleur en fonction du choix réaliser dans le menu déroulant via une macro.

J'ai déjà trouver le moyen de récupérer la couleur de font par la fonction: "ActiveCell.Interior.ColorIndex".

Comme le choix sélectionner dans le menu déroulant peut revenir plusieurs fois et avec des couleurs différentes, je dois faire la recherche de ce choix directement dans le nom du champ correspondant.
Pour l'instant, je bloque sur la récupération du nom/champ qui sert à la data validation.



Si quelqu'un peut m'aider?

Merci d'avance

[White Mibu]

Bonjour,

met cette macro dans "ThisWorkBook", je t'envoi le fichier joint. La couleur de remplissage reprend celle de la case sans passer par la validation de données.
Par contre tu ne voit toujours pas la couleur de remplissage dans la liste déroulante...

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
Dim Plage As Range, Noms As Range, CelNom As Range, Celcouleur As Range
Set References = Range("Empty_head") 'situation est définit dans Excel via menu/insertion/nom/définir
On Error Resume Next 'Permet d'arreter la macro sans message en d'erreur
If Sh.Name = ("Synoptic_Mini_Midi_Maxi") Then 'Feuille du classeur avec liste déroulante
    Set Plage = Range("C11") 'Plage dans la feuille du classeur
'ElseIf Sh.Name = ("3 quadri 2005") Then 'Exemple si tu veut mettre une autre feuille ou autre plage, voir ligne suivante
    'Set Plage = Range("D4:D33,H4:H34,L4:L33,P4:P34")
Else: Exit Sub
End If
If Not Intersect(Target, Plage) Is Nothing Then
    For Each CelNom In Intersect(Target, Plage)
        For Each Celcouleur In References
            If CelNom = Celcouleur Then
                CelNom.Interior.ColorIndex = Celcouleur.Interior.ColorIndex
                CelNom.Font.ColorIndex = Celcouleur.Font.ColorIndex
                Exit For
                End If
            Next Celcouleur
        Next CelNom
    End If
End Sub

peut-être que cette macro t'aidera... en espérant que tu trouve la solution à ton problème

[duboisgs]

Bonjour White Mibu,

Merci pour cette réponse.
J'ai téléchargé ton fichier mais je n'arrive pas à faire tourner la macro en pas à pas (touche F8) ou même en continu
Mes notions en macro sont moyennes.

je ne connais pas les Private Sub?
Merci encore pour m'aider à lancer la macro

[duboisgs]

Je pense avoir compris!
Comme la macro est dans la feuille elle fonctionne à chaque fois que l'on change quelque chose dans le range défini.

Est-ce exact?
D'un autre côté, tu as défini une nouvelle zone "empty_head" et la macro ne fonctionne que dans ce cas de figure en version "Mini"

Si je choisi la version Maxi en C5 cela ne fonctionne plus!
Il faut bien utiliser la fonction indirect en C11.
C'est bien là l'avantage de pouvoir mettre des couleurs différentes en fonction du :
1. du choix dans le menu déroulant mais aussi
2. en fonction du choix indirect dans d'autre menu déroulant (fonction INDIRECT).
par exemple

si C5= Mini alors la liste en

C11 fait référence à la zone Mini_reflectors et
C13/C17 feront elles-même référencent à une liste resultant de 2 choix indirects (à savoir C5 et C11)

si C5= Midi alors la liste en C11 fait référence à la zone Midi_reflectors

J'ai remis le fichier excel avec la fonction INDIRECT en C11.

D'un autre côté, je souhaite que l'ajout des couleurs se fasse pour tout le tableau range A1:IV65536 mais à ce moment est-ce que la macro ne va pas ralentir?

Tu trouveras ci-joint le fichier Synoptic(2)

[White Mibu]

C'est normal la macro s'exécute à chaque changement que tu fait sur toutes les feuille !

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
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
Dim Plage As Range, Noms As Range, CelNom As Range, Celcouleur As Range
 
Set Reference1 = Range("Head_orientation") 'situation est définit dans Excel via menu/insertion/nom/définir
Set Reference2 = Range("Empty_head") 'Gestionnaires des noms, colonne Empty_head !
'Ajoute autant de références que tu veut...
 
On Error Resume Next 'Permet d'arreter la macro sans message en d'erreur
If Sh.Name = ("Synoptic_Mini_Midi_Maxi") Then 'Feuille du classeur avec liste déroulante
    Set Plage = Range("C11:C10") 'Plage dans la feuille du classeur ici cela concerne les cases C10 jusqu'à C11
    'Pour différentes plage sur la même feuille : Set Plage = Range("D4:D33,H4:H34,L4:L33,P4:P34" par exemple
Else: Exit Sub
End If
 
'Ce bloc concerne la première référence
If Not Intersect(Target, Plage) Is Nothing Then
    For Each CelNom In Intersect(Target, Plage)
        For Each Celcouleur In Reference1
            If CelNom = Celcouleur Then
                CelNom.Interior.ColorIndex = Celcouleur.Interior.ColorIndex
                CelNom.Font.ColorIndex = Celcouleur.Font.ColorIndex
                Exit For
                End If
            Next Celcouleur
        Next CelNom
    End If
 
    'Pour chaque référence copie cette partie de la macro
    If Not Intersect(Target, Plage) Is Nothing Then
    For Each CelNom In Intersect(Target, Plage)
        For Each Celcouleur In Reference2 'Adapter la référence !
            If CelNom = Celcouleur Then
                CelNom.Interior.ColorIndex = Celcouleur.Interior.ColorIndex
                CelNom.Font.ColorIndex = Celcouleur.Font.ColorIndex
                Exit For
                End If
            Next Celcouleur
        Next CelNom
    End If
 
End Sub

J'ai essayé de te guidé un peu plus, et j'ai rajouter la colonne Head_origine regarde sur ton deuxième onglet. La macro fait en sorte de copier la couleur de remplissage de la cellule d'origine... C'est ça que tu voulais ?

Pour voir si la macro fonctionne, change les couleurs de remplissage des cellules en question du premier onglet.
Sélectionne le choix que tu as changé dans le deuxième onglet et normalement la couleur est la même que celle du premier onglet

Dit moi si ça marche de ton côté... moi ça fonctionne si c'est ça que tu voulais...

[White Mibu]

J'ai vu ta réponse trop tard... oui t'a compris, je sais pas si ça va ralentir faut tester ! Par contre les nouvelles zones, faut les ajouter à la macro. Dans mon dernier message j'en ai ajouter une ? Es-que tu voit comment en ajouter d'autres ?

Après il y a peut-être d'autre solution... faut voir si cela te convienne !

[duboisgs]

C'est bien ce que je cherche.

Puis-je te demander une dernière chose?

de sorte à ne pas mettre plusieurs refrence( Reference2,Reference3,...)
j'étais parti en récupérant l'info (Formula1) dans la data validation de sorte à faire une recherche ....

Mais je bloque sur :

Code :

Application.Goto Reference:=Nom_Z_C

Ne peut-on pas utiliser ?

Code :

Nom_Z_C = ActiveCell.Validation.Formula1

quand on est sur une cellule avec validation et le cumuler avec ta macro sans faire "x" Reference?

Merci d'avance

voici mon début de macro:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub synoptic1()
 
'sélectionner le contenu choisi dans la liste déroulante
 
Choix = ActiveCell.Value
 
'capture de la zone de champ correpondante à la datavalidation
Nom_Z_C = ActiveCell.Validation.Formula1
 
'recherche find du choix dans la zone de champ correspondant
 
Application.Goto Reference:=Nom_Z_C
 
    Selection.Find(What:=Choix, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.FindNext(After:=ActiveCell).Activate
 
'sélectionner le code couleur de la cellule recherchée et l'appliquer au choix de la liste déroulente
C = ActiveCell.Interior.ColorIndex
 
End Sub

[White Mibu]

Je pense pas qu'il est possible de récupérer le nom de la liste déroulante...

Une solution pourrait être de déclarer toutes les références, les associées à un chiffre. Ensuite en fonction de la ligne qui est active faire appel à une référence en particulier... ?

C'est un peut laborieux mais moi j'vois que ça... peut-être quelqu'un d'autre pourrait plus t'aidé

[duboisgs]

La fonction suivante marche

Code :

Nom_Z_C = ActiveCell.Validation.Formula1

Excel donne comme valeur "=INDIRECT($C5&"_reflectors")"

mais je n'arrive pas à l'intégrer dans la fonction goto ...

Code :

Application.Goto Reference:=Nom_Z_C

Excel me renvoit un message d'erreur : " Run-time error '1004' Reference is not valid

Est-ce que quelqu'un peut m'aider ?

[duboisgs]

Salut White Mibu.

J'ai réusi à intégrer la fonction Goto à ta macro,

cela donne ceci.

Merci encore pour ton aide.

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
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
Dim Plage As Range, Noms As Range, CelNom As Range, Celcouleur As Range
'Set References = Range("Empty_head") 'situation est définit dans Excel via menu/insertion/nom/définir
Set References = Range(ActiveCell.Validation.Formula1) 'situation est définit dans Excel via menu/insertion/nom/définir
 
On Error Resume Next 'Permet d'arreter la macro sans message en d'erreur
If Sh.Name = ("Synoptic_Mini_Midi_Maxi") Then 'Feuille du classeur avec liste déroulante
    Set Plage = Range("A1:AA1000") 'Plage dans la feuille du classeur
'ElseIf Sh.Name = ("3 quadri 2005") Then 'Exemple si tu veut mettre une autre feuille ou autre plage, voir ligne suivante
    'Set Plage = Range("D4:D33,H4:H34,L4:L33,P4:P34")
Else: Exit Sub
End If
If Not Intersect(Target, Plage) Is Nothing Then
    For Each CelNom In Intersect(Target, Plage)
        For Each Celcouleur In References
            If CelNom = Celcouleur Then
                CelNom.Interior.ColorIndex = Celcouleur.Interior.ColorIndex
                CelNom.Font.ColorIndex = Celcouleur.Font.ColorIndex
                Exit For
                End If
            Next Celcouleur
        Next CelNom
    End If
End Sub

[White Mibu]

De rien, content que tu y sois arrivé !

Le plus dur a été de comprendre ce que tu voulais

N'oublie pas de mettre résolu, bonne continuation !