Couleur Shape quand clique
Bonjour,
je travaille sur une carte où chaque département est au format Shape pour y affecter une macro.
Tous les shapes ont la même couleur et quand on clique sur un département(shape) celui-ci prend une autre couleur.
Cette partie de mon programme ne marche pas, je ne comprends pas pourquoi.
J'espère que vous pourrez m'aider.
Voici la partie de mon code qui ne fonctionne pas, tout le reste fonctionne parfaitement.
Sub Click_carte()
' ******Affiche des informations synthétiques par département lorsqu'il y a clique sur un département
' Déclaration des variables
Dim i As Integer
Dim J As Integer
Dim derniereLigne As Long
Dim nb As Integer
nb = 0
' variable nom de la forme
Dim NomShape As String
Dim nomDept As String
Dim Shape As Shape
'Permet de détecter quelle forme a été cliquée
NomShape = Application.Caller
'Mise en couleur par défaut sur toutes les formes de la feuille active
Sheets("Cartographie").Select
For Each Shape In ActiveSheet.Shapes
Shape.Fill.ForeColor.RGB = RGB(230, 224, 236)
Next Shape
'Affectation d'une couleur quand la forme est sélectionnée
ActiveSheet.Shapes(NomShape).Fill.ForeColor.RGB = RGB(204, 192, 218)
End subJ'ai une erreur au niveau de la boucle "'Mise en couleur par défaut sur toutes les formes de la feuille active", ligne Shape.Fill.ForeColor.RGB = RGB(230, 224, 236)
Merci pour votre aide,
Bonne journée
Bonjour,
pas de fichier, pas facile de tester...
Dans :
Shape.Fill.ForeColor.RGB = RGB(230, 224, 236)
essayez d'enlever le premier RGB, pour obtenir :
Shape.Fill.ForeColor = RGB(230, 224, 236)
@ bientôt
LouReeD
Merci LouReeD,
je viens de tester et cela ne fonctionne pas.
Après quelques essais, je me rends compte que la macro fonctionne lorsque j'enlève les segments.
Les segments de ma feuille font référence à un TCD de la feuille "Calcul".
Les segments me permettrons d'afficher les données avec un niveau plus fin (Territoire, Contractualisation et état) que le Shape qui ne filtre que sur le territoire.
Je ne comprends pas les segments qui en sont pas liés au Shape ont un impact sur ma macro.
En pj, un fichier simplifié.
Merci
Re
la boucle de colorisation des shapes fait 27 tours pour seulement 12 départements !
Le mieux serait de "renommer" les départements en ajoutant un "_" au début, et dans la boucle faire un test sur le premier caractère du nom : si c'est un "_" on colorie, sinon on ne faite rien...
@ bientôt
LouReeD
Merci,
mais si je change le nom des Shapes avec _devant, je ne pourrai plus afficher dans le tableau à coté de la carte les informations qui correspondent au département?
Le nom du shape, me permet de récupérer des informations qui sont dans la feuille"BDD".
je suis pas une experte en VBA, donc il y a peut-être des moyens plus simples.
une petite chose :
vu que lorsque l'on clic sur un département on est sur la feuille "cartographie" alors cette instruction ne sert à rien :
'Mise en couleur par défaut sur toutes les formes de la feuille active
Sheets("Cartographie").SelectPar contre pour éviter le "scintillement" de l'écran vous pouvez la remplacer par :
Application.ScreenUpdating = False@ bientôt
LouReeD
pour la récupération de données il suffira de faire une recherche sans le "_" :
Nomdépartement = right(shape.name,len(shape.name)-1)
ce qui veut dire qu'on prend pour le nom du département "cliqué" le nom du chape en prenant les lettres à partir de la droite sur une longueur de caractère égale aux nombre de caractère du nom du shape -1 lettre, donc en partant de la droite on retire le "_"
@ bientôt
LouReeD
le code modifié, rest à ajouter les "_" aux différent noms :
Sub Click_carte()
' ******Macro affiche des informations synthétiques par département lorsqu'il y a clique sur un département
' Déclaration des variables
Dim i As Integer
Dim J As Integer
Dim derniereLigne As Long
Dim nb As Integer
nb = 0
' variable nom de la forme
Dim NomShape As String
Dim nomDept As String
Dim Shape As Shape
Derniere_ligne = Sheets("BDD").Range("A2").End(xlDown).Row
'Permet de détecter quelle forme a été cliquée
NomShape = Application.Caller
NomShape = Right(NomShape, Len(NomShape) - 1)
Application.ScreenUpdating = False
'Mise en couleur par défault sur toutes les formes de la feuille active
For Each Shape In ActiveSheet.Shapes
If Left(Shape.Name, 1) = "_" Then Shape.Fill.ForeColor.RGB = RGB(230, 224, 236)
Next Shape
'Affectation d'une couleur quand la forme est sélectionnée
ActiveSheet.Shapes("_" & NomShape).Fill.ForeColor.RGB = RGB(204, 192, 218)
'nettoie le tableau de synthèse
Sheets("Cartographie").Range("L26:U67").ClearContents
'Affiche dans le tableau de synthèse
Sheets("BDD").Cells(1, 1).AutoFilter
Sheets("BDD").Range("$A$1:$Z$500").AutoFilter Field:=2, Criteria1:=NomShape
For i = 2 To 500
If Sheets("BDD").Cells(i, 2) = NomShape Then
nb = nb + 1
Sheets("Cartographie").Cells(25 + nb, 12) = Sheets("BDD").Cells(i, 2) 'Territoire
Sheets("Cartographie").Cells(25 + nb, 13) = Sheets("BDD").Cells(i, 1) 'Contractualisation
Sheets("Cartographie").Cells(25 + nb, 14) = Sheets("BDD").Cells(i, 3) 'Nom de la contractualisation
Sheets("Cartographie").Cells(25 + nb, 15) = Sheets("BDD").Cells(i, 4) 'Secteur
Sheets("Cartographie").Cells(25 + nb, 16) = Sheets("BDD").Cells(i, 8) 'Statut
Sheets("Cartographie").Cells(25 + nb, 17) = Sheets("BDD").Cells(i, 16) 'Thématique d'action
Sheets("Cartographie").Cells(25 + nb, 18) = Sheets("BDD").Cells(i, 15) 'Périmètre d'action
Sheets("Cartographie").Cells(25 + nb, 19) = Sheets("BDD").Cells(i, 5) 'Date de signature
Sheets("Cartographie").Cells(25 + nb, 20) = Sheets("BDD").Cells(i, 6) 'Date fin prévue
Sheets("Cartographie").Cells(25 + nb, 21) = Sheets("BDD").Cells(i, 12) 'Budget
End If
Next i
Sheets("BDD").Select
Selection.AutoFilter
Sheets("calcul").Activate
Range("H4").Select
ActiveSheet.PivotTables("Nb_contractualisation").PivotCache.Refresh
Sheets("Cartographie").Activate
Range("A1").Select
End Sub@ bientôt
LouReed
Merci bcp,
tout fonctionne.
Bonne journée.
Merci de vos remerciements !
Ceci dit il y a encore beaucoup de "select" dans votre code...
@ bientôt
LouReeD