colorer des shapes suivant une liste de villes

Le
Patrick
Bonjour,

je reviens un peu sur mon PC après quelques semaines d'absence et je
suis confronté à un problème de mise en couleur de "shapes";
j'ai une liste de communes avec une couleur de fond sur la ligne qui la
contient, j'aimerais remplir la carte à sa gauche suivant la teinte de
cette cellule, donc si Charleroi est en bleu dans la liste , la région
de charleroi sur la carte sera bleue; ici j'ai un code avec un double
clic mais je voudrais une boucle sur l'ensemble des (max 36) communes
et je n'y arrive pas :(


Merci de votre aide

Patrick

voici mon fichier sur dropbox

https://www.dropbox.com/s/27swn9hcufl3vq6/carte%20hainaut.xlsm?dl=0


L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #26370877
Bonjour,

Essaie comme ceci :

'------------------------------------------------------
Sub MichD()
Dim Communes As Range, C As Range, Sh As Shape
With Feuil5 'Ou Worksheets("CarteCouleur2014")
Set Communes = .Range("Y2:Y37")
End With

For Each C In Communes
If C.Row = 37 Then Stop
With Feuil5.Shapes.Range(Array(C.Value)).Fill
.Visible = msoTrue
.ForeColor.RGB = C.Interior.Color
End With
Next
End Sub
'------------------------------------------------------
MichD
Le #26370876
Supprime cette ligne de code de la procédure, elle n'a plus aucune utilité...

If C.Row = 37 Then Stop

'------------------------------------------------------
Sub MichD()
Dim Communes As Range, C As Range, Sh As Shape
With Feuil5 'Ou Worksheets("CarteCouleur2014")
Set Communes = .Range("Y2:Y37")
End With

For Each C In Communes
With Feuil5.Shapes.Range(Array(C.Value)).Fill
.Visible = msoTrue
.ForeColor.RGB = C.Interior.Color
End With
Next
End Sub
'------------------------------------------------------
MichD
Le #26370974
Tu peux utiliser cette présentation du code si tu préfères :

'--------------------------------------------
Sub MichD()
Dim C As Range
With Feuil5 'Ou Worksheets("CarteCouleur2014")
For Each C In .Range("Y2:Y" & .Range("Y" & .Rows.Count).End(xlUp).Row)
With .Shapes.Range(Array(C.Value)).Fill
.Visible = msoTrue
.ForeColor.RGB = C.Interior.Color
End With
Next
End With
End Sub
'--------------------------------------------



"MichD" a écrit dans le message de groupe de discussion : mv8u2u$2ro$

Supprime cette ligne de code de la procédure, elle n'a plus aucune utilité...

If C.Row = 37 Then Stop

'------------------------------------------------------
Sub MichD()
Dim Communes As Range, C As Range, Sh As Shape
With Feuil5 'Ou Worksheets("CarteCouleur2014")
Set Communes = .Range("Y2:Y37")
End With

For Each C In Communes
With Feuil5.Shapes.Range(Array(C.Value)).Fill
.Visible = msoTrue
.ForeColor.RGB = C.Interior.Color
End With
Next
End Sub
'------------------------------------------------------
Patrick
Le #26370987
Merci Denis :)

simple et efficace :)

Patrick

Le 10/10/2015 11:47, MichD a écrit :
Tu peux utiliser cette présentation du code si tu préfères :

'--------------------------------------------
Sub MichD()
Dim C As Range
With Feuil5 'Ou Worksheets("CarteCouleur2014")
For Each C In .Range("Y2:Y" & .Range("Y" & .Rows.Count).End(xlUp).Row)
With .Shapes.Range(Array(C.Value)).Fill
.Visible = msoTrue
.ForeColor.RGB = C.Interior.Color
End With
Next
End With
End Sub
'--------------------------------------------



"MichD" a écrit dans le message de groupe de discussion :
mv8u2u$2ro$

Supprime cette ligne de code de la procédure, elle n'a plus aucune
utilité...

If C.Row = 37 Then Stop

'------------------------------------------------------
Sub MichD()
Dim Communes As Range, C As Range, Sh As Shape
With Feuil5 'Ou Worksheets("CarteCouleur2014")
Set Communes = .Range("Y2:Y37")
End With

For Each C In Communes
With Feuil5.Shapes.Range(Array(C.Value)).Fill
.Visible = msoTrue
.ForeColor.RGB = C.Interior.Color
End With
Next
End Sub
'------------------------------------------------------




---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Publicité
Poster une réponse
Anonyme