Colorer des formes libres en fonction de cellules

Bonjour à toutes et tous,

Je vous écris aujourd'hui avec un problème somme toute plus simple à expliquer / décrire qu'à résoudre, et ce sur Excel 2010 :

J'aimerais colorer les Etats d'une carte des USA en fonction des montants ventes réalisées dans chacun des Etats. Si je fais une macro et non pas un remplissage manuel, c'est parce qu'en réalité on va produire un fichier mis à jour de manière dynamique pour les 50 Etats.

J'ai renommé les formes libres pour que les noms des formes correspondent à ceux des Etats, car en ayant parcouru d'autres forums, cela m'a semblé être une étape nécessaire.

Voici le dégradé de couleurs que j'aimerais appliquer :

Pour des ventes de 0 à 100 : R = 255 / G = 255 / B = 255

Pour des ventes de 101 à 200 : R = 205 / G = 255 / B = 205

Pour des ventes de 201 à 300 : R = 143 / G = 255 / B = 143

Pour des ventes de 301 à 400 : R = 0 / G = 168 / B = 0

Pour des ventes de 401 à 500 : R = 0 / G = 104 / B = 0

J'imagine qu'il faut écrire une macro, or je n'ai aucune expérience en VBA.. C'est pourquoi je fais appel à vous

Excellente journée à tous,

Thomas

Bonjour,

sélectionner les états de la cellule B3 jusqu'à la cellule B8 puis nommer cette sélection States .

Pour les couleurs, saisir la borne inférieure dans une cellule puis à sa droite les codes RGB séparés d'un espace.

Exemple pour la première : cellule de gauche = 0 et cellule de droite = 255 255 255 …

Continuer en dessous dans l'ordre croissant des bornes inférieures puis nommer cette plage de deux colonnes Couleurs .

Grâce à ces deux plages nommées, le code en est simplifié :

Sub Demo()
     Dim Rg As Range
For Each Rg In [States]
    SP = Split(Application.VLookup(Rg.Offset(, 1).Value, [Couleurs], 2))
    If UBound(SP) = 2 Then Feuil1.Shapes(Rg.Value).Fill.ForeColor.RGB = RGB(SP(0), SP(1), SP(2))
Next
End Sub

Bonjour Marc et merci de cette prompte réponse !

Je vais essayer de mettre tout cela en pratique et reviendrai vers vous si toutefois il me reste des questions

Excellente journée,

Thomas

Bonjour à nouveau, Marc et les autres,

Je viens d'essayer d'intégrer cela à mon fichier de travail (cf. PJ), et un bug apparaît. J'ai tout à fait l'impression qu'il s'agit d'un problème élémentaire, mais (au risque de me répéter) n'ayant aucune expérience, je ne comprends pas comment VBA réfléchit et donc je ne vois pas où l'erreur est

En pratique, mon fichier a plusieurs onglets (pour des raisons évidentes de confidentialité, je ne peux malheureusement pas tout mettre en ligne :/ ), et les chiffres de 'ventes' en colonne E sont en réalité issus d'une SOMME.SI.ENS. Toutefois, je ne pense pas que cela soit le problème.

Je viens de commander Excel VBA pour les Nuls, je pense qu'on va bien s'entendre, ce livre et moi !

L'erreur pourrait être déclenchée par exemple si une carte n'existe pas pour un état …

Merci beaucoup Marc, j'ai donc fait le tour des formes sur le document et effectivement, la liste d'Etats dans le range 'shapes' ne correspondait pas aux noms des formes.

Néanmoins, cette première erreur étant réparée (j'ai supprimé et renommé un certain nombre d'Etats, dont Hawaii, les Samoa US, les Îles Vierges, etc.), la macro ne tourne toujours pas.

Le message d'erreur que je reçois est :

'Erreur d'exécution 424 / Objet requis'

Quand je lance le débogage, la partie du code qui semble poser problème est :

Feuil1.Shapes(Rg.Value).Fill.ForeColor.RGB = RGB(SP(0), SP(1), SP(2))

Est-ce qu'il y a des éléments à adapter dans le code ou pensez-vous que cela vienne de la feuille de calcul ?

En dehors du nom de la forme, reste la feuille … C'est bien Feuil1 ? Sinon remplacer par Rg.Parent …

Bonjour,

Coloriage avec fonction personnalisée

En d3:

=colorieimage(B3;couleurcellule(B3))

Function ColorieImage(s, couleur)
  Application.Volatile
  Set f = Sheets(Application.Caller.Parent.Name)
  f.Shapes(s).Fill.ForeColor.RGB = couleur
End Function

Function CouleurCellule(c As Range)
  Application.Volatile
  CouleurCellule = c.Interior.Color
End Function

http://boisgontierjacques.free.fr/fichiers/Images/ColorierShapes2.xls

Ceuzin

Bonjour Ceuzin et merci beaucoup pour cette nouvelle réponse ! J'essaie de l'intégrer au dernier fichier et de voir comment ça fonctionne