[XL-2007] Coloriér une freeform en fonction du résultat d'une case

Bonjour à tous,

J'ai bien avancé sur mon fichier mais je bloque sur des détails.

J'ai renommé mes freeforms de ma carte pas des noms des départements exemple freeforme32= "Gironde".

J'aimerai que lorsque la case M32 affiche une région la freeform correspondant à cette zone se colore de la couleur du commercial

Exemple: si la case M32 affiche Gironde ma freeform Gironde se colorie automatiquement de la même couleur que la personne qui gère cette zone en vert dans ce cas.

Pour vous indiquer qui géré quoi j'ai crée des boutons allumant les zones sur la carte (d'ailleurs si vous pourriez modifié mon code afin que lorsque on clique une fois sur ce bouton, la zone se colorie et une autre fois la zone redevient neutre, cela serait plus ergonomique).

Merci à tous pour votre aide !

Bonjour,

à tester,

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$M$42" Then
  ActiveSheet.Shapes(Target.Value).OLEFormat.Object.Interior.Color = RGB(255, 0, 0)
End If
End Sub

Bonjour,

Merci pour l'aide mais cela ne fonctionne pas j'ai essayé votre formule :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$M$42" Then
  ActiveSheet.Shapes(Target.Value).OLEFormat.Object.Interior.Color = RGB(255, 0, 0)
End If
End Sub

mais également car il me semble qu'il faut cibler la case M32 et pas 42 mais cela ne fonctionne pas plus...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$M$32" Then
  ActiveSheet.Shapes(Target.Value).OLEFormat.Object.Interior.Color = RGB(255, 0, 0)
End If
End Sub

Bonjour,

voici un exemple,

est ce que ça convient ?

Bonjour l'idée est bonne est semble fonctionner

Bonjour,

Fonction de coloriage d'une image

Ceuzin

pa2peau: Bonjour l'idée est bonne est semble fonctionner

Si il y a d'autre formes à ne pas prendre en compte, il sera plus facille de les ajouter à cette macro,

aussi les couleurs pourraient être déterminer à l'avance sur une plage

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$M$32" Then
 If Target.Value <> "" Then

  For Each shp In ActiveSheet.Shapes
    Select Case Left(shp.Name, 4)
     Case "Drop":
     Case Else: shp.Fill.Visible = msoFalse
    End Select
  Next

  couleur = Application.Match(Target, Sheets("couleur").Range("A:A"), 0)
  r = Sheets("couleur").Cells(couleur, 2)
  g = Sheets("couleur").Cells(couleur, 3)
  b = Sheets("couleur").Cells(couleur, 4)

  ActiveSheet.Shapes(Target.Value).OLEFormat.Object.Interior.Color = RGB(r, g, b)
 End If
End If
End Sub