Manipuler une sélection dynamique de formes
Bonjour à tous,
Je réalise une carte du monde qui doit permettre de visualiser quel partenaire est responsable de quel pays. Il y a donc plusieurs pays (une centaine), et plusieurs responsables (une vingtaine). Dans mon tableur, les pays sont des formes issues de D-maps (mais pour l'exemple j'ai juste mis des rectangles ici).
Pour qu'il soit facile de savoir graphiquement qui s'occupe de quelle zone j'ai un code couleur qui colorie les pays en fonction du responsable en charge.
Le soucis est que je ne sais pas comment colorier un ensemble de formes qui est amené à changer. Je pourrais faire une ligne de code par forme, mais ce serait trop long pour une centaine de pays.
Je souhaite donc savoir comment faire en sorte que tous les pays qui répondent à la condition responsable="Louis" soient automatiquement coloriés en orange, tous ceux répondant à la condition responsable="Matthieu" soient coloriés en rouge, etc.
Jusqu'ici j'ai ça, mais ce n'est pas du tout dynamique :
Worksheets("PAYS").Shapes.Range(Array("BRESIL", "ARGENTINE")).Fill.ForeColor.RGB = RGB(245, 180, 15)
Voilà le type de fichier sur lequel je suis amené à travailler.
D'avance merci, parce que là, je bloque !
Cordialement,
Martin.
Bonjour,
Je n'aime décidément pas les "tableaux" (toujours des surprises)...
Ton exemple était un peu succinct, et il fallait aller chercher les couleurs dans les formats conditionnels (ce qui ne garantit une adéquation avec les couleurs du tableau que si les formats ont été ajoutés dans l'ordre alphabétique des responsables).
Voici tout de même un essai (qui fonctionne) en attendant d'autres.
Sub Remplissage()
Dim resp, clr, i%, j%, k%
With Worksheets("PAYS")
.Range("I2:K7").Sort key1:=.Range("K2"), order1:=xlAscending, Header:=xlYes
With .Range("I3:K7")
Do While i < .Rows.Count
i = i + 1: k = k + 1
clr = .Cells(i, 3).FormatConditions(k).Interior.Color
resp = .Cells(i, 2).Value
Do While .Cells(i + 1, 3) = .Cells(i, 3)
resp = resp & " " & .Cells(i + 1, 2).Value
i = i + 1
Loop
resp = Split(resp)
For j = 0 To UBound(resp)
Worksheets("PAYS").Shapes(resp(j)).Fill.ForeColor.RGB = clr
Next j
resp = ""
Loop
End With
End With
End SubCordialement
Votre solution fonctionne parfaitement.
Merci beaucoup !