Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 création d'une carte interactive

PAPICH

XLDnaute Nouveau
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 FreeformDpartements
AiglunFreeform 177Alpes-de-Haute-Provence
Allemagne-en-ProvenceFreeform 215Alpes-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

XLDnaute Barbatruc
Re

Pour repérer et colorier la commune

VB:
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

XLDnaute Nouveau

Je vous remercie beaucoup, car j'ai vraiment bloqué sur ce code
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…