XL 2019 création d'une carte interactive

[PAPICH]

Bonjour
j'ai pour une association créé une carte interactive de la région PACA, chaque commune est une freeform, donc 6 départements et 947 communes, que j'ai coloriser et regroupé en canton. mis dans un un module comme ceci:

Sub Region_PACA()
With ActiveSheet
'*************************************
'Département Alpes-de-Haute-Provence *
'*************************************

'*************************
'Canton de Barcelonnette *
'*************************

.Shapes("Freeform 20").Fill.ForeColor.RGB = RGB(146, 182, 218)
.Shapes("Freeform 18").Fill.ForeColor.RGB = RGB(146, 182, 218)
.Shapes("Freeform 23").Fill.ForeColor.RGB = RGB(146, 182, 218)
.Shapes("Freeform 21").Fill.ForeColor.RGB = RGB(146, 182, 218)

End With
End Sub

toute mes commune sont listé dans une feuille "info" comme ceci :

nom commune	Freeform	Dpartements
Aiglun	Freeform 177	Alpes-de-Haute-Provence
Allemagne-en-Provence	Freeform 215	Alpes-de-Haute-Provence

sur ma feuille "carte":
j'ai fait une validation de donnée avec la source =Info!$G$2:$G$7, qui regroupe la liste des départements
et une validation de donnée avec la source =DECALER(Info!A1;EQUIV(B40;Info!C2:C947;0);;NB.SI(Info!C2:C947;B40);1), pour avoir la liste des communes du département

mon projet est lorsque j'ai choisie une commune dans ma liste je souhaiterais que la "freeform" qui correspond à la commune passe en rouge pour la visualiser sur la carte.
et la je bloc pour l'écriture du code VBA, car j'y connait peut de chose sur le VBA.

je vous remercie sur l'attention sur la lecture de mon message, et remercie par avance pour l'aide apporté à la création des ligne de code

 

[pierrejean]

Bonjour PAPICH

Avec une copie du fichier éventuellement expurgée des données sensibles on serait plus à l'aise pour t'aider

 

[PAPICH]

Bonjour PAPICH

Avec une copie du fichier éventuellement expurgée des données sensibles on serait plus à l'aise pour t'aider

Bonjour le fichier est trop gros pour être télécharger je pense que c'est du à la carte, vous pouvez l'avoir sur se lien http://dl.free.fr/w3RPhxqiP je suis désolé pour cette procédure, mais merci d'avance pour votre aide

 

[pierrejean]

Re

Pour repérer et colorier la commune

If Target.Address = "$D$42" Then
  Set c = Sheets("Info").Columns(1).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        sh = Sheets("Info").Range("D" & c.Row)
         Shapes(sh).Fill.ForeColor.RGB = RGB(255, 0, 260)
    End If
End If

 

[PAPICH]

Re

Pour repérer et colorier la commune

If Target.Address = "$D$42" Then
  Set c = Sheets("Info").Columns(1).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        sh = Sheets("Info").Range("D" & c.Row)
         Shapes(sh).Fill.ForeColor.RGB = RGB(255, 0, 260)
    End If
End If

Je vous remercie beaucoup, car j'ai vraiment bloqué sur ce code