Microsoft 365 Carte de france Dynamique

[pascaleg80]

Bonjour, je souhaite créer une carte de France avec des codes couleurs par département en fonction d'un pourcentage d'atteinte. Quelqu'un peut il m'aider s'il vous plait?
Si je dois résumer, si un département à un %tage d'atteinte d'objectif inf à 80% = Rouge/ entre 80 et 90% (non inclus) = orange et au dela vert/ Si pas de %tage de renseigné, laisser le dép sans couleur.
Ci-joint un fichier pour comprendre ma demande.

Merci par avance et bonne semaine à toutes et tous

 

[Dudu2]

Bonjour Job75,
Elle est très bien ta solution. L'échelle des couleurs est transposée dans des MFC ce qui la rend originale et ingénieuse avec l'utilisation de DisplayFormat pour récupérer la couleur intégrant l'action des MFC.
D.

 

[job75]

Merci Dudu2 pour l'appréciation, j'aurais aimé en avoir une de pascaleg80.

 

[Dudu2]

Job, elle n'a peut-être pas réalisé à l'ouverture de ton classeur que tu avais finalisé une solution.
Moi-même, lorsque je t'ai fait la remarque sur la carte, je n'ai pas compris que sur l'autre feuille la carte était colorisée selon les données. En lecture rapide je n'ai pas vu le commentaire en haut. Je cherchais un bouton ou un truc du genre.

 

[patricktoulon]

bonjour @Dudu2 , @job75
@job75 je te propose de faire un tout petit ajout a ton modèle c'est la compatibilité avec 2007
c'est pas grand chose mais ca peut servir

Option Explicit

Private Sub Worksheet_Activate()
    Dim s As Shape, c As Range
    Application.ScreenUpdating = False
    '---RAZ---
    For Each s In Shapes
        s.Fill.ForeColor.RGB = vbWhite
    Next
    '---Couleur---
    On Error Resume Next
    For Each c In Feuil1.PivotTables(1).TableRange1.Columns(1).Cells
        Set s = Nothing
        Set s = Shapes("FR-" & IIf(IsNumeric(c), Format(c, "00"), c))
        '===============================================================
        'version Excel superieure à 2007
        If Val(Application.Version) > 12 Then
            s.Fill.ForeColor.RGB = c(1, 5).DisplayFormat.Interior.Color
        Else
            ' et pour excel 2007 <<"fonctionne aussi avec les versions superieures>>"
            s.Fill.ForeColor.RGB = GetConditionColor2007(c(1, 5))
        End If
        '=============================================================
    Next
End Sub
Function GetConditionColor2007(cel)
    Select Case True
    Case cel > 94 / 100: GetConditionColor2007 = Feuil1.Range("E:E").FormatConditions(1).Interior.Color
    Case cel >= 88 / 100 And cel < 94 / 100: GetConditionColor2007 = Feuil1.Range("E:E").FormatConditions(2).Interior.Color
    Case cel < 88 / 100 / Abs(cel < 94 / 100): GetConditionColor2007 = Feuil1.Range("E:E").FormatConditions(3).Interior.Color
    End Select
End Function

testé sur 2007 2013 2016 (32 bits)

 

[job75]

Bonjour à tous,

@patricktoulon ma solution est intéressante parce qu'elle utilise DisplayFormat.

Si cette propriété n'est pas disponible utiliser les tests qui déterminent les couleurs, fichier (2) :

Private Sub Worksheet_Activate()
Dim s As Shape, c As Range, v#
Application.ScreenUpdating = False
'---RAZ---
For Each s In Shapes
    s.Fill.ForeColor.RGB = 16777215
Next
'---Couleur---
On Error Resume Next
For Each c In Feuil1.PivotTables(1).TableRange1.Columns(1).Cells
    Set s = Nothing
    Set s = Shapes("FR-" & IIf(IsNumeric(c), Format(c, "00"), c))
    v = Val(Replace(CStr(c(1, 5)), ",", "."))
    If v > 0 Then s.Fill.ForeColor.RGB = IIf(v < 0.88, 255, IIf(v >= 0.88 And v < 0.94, 49407, 5296274))
Next
End Sub

A+

 

[patricktoulon]

re
Bonjour job75
pourquoi re coder les long ?
autant utiliser les couleurs des conditions sans chercher a connaitre son code long non?
puisque on les a dispo en lecture ?

 

[job75]

Bah les MFC peuvent avoir été effacées ou être erronées.

 

[patricktoulon]

re
et donc dans le tableau aussi
??????????
ça n'a plus aucuns sens après alors puisque ton modèle est basé sur le displayformat

 

[Pierre Fauconnier]

Bonjour, effectivement, j'ai testé votre fichier et une erreur ne m'a pas permis d'aller plus loin

Une erreur dans une solution de Patrick? (Arf, ça me rappelle tellement de choses que je préfère oublier...)

 

[pascaleg80]

L'Équipe,
Grâce à vos cartes et détail Paris, j'ai pu améliorer la chose et propose cette version à Pascale.
Si y a des points à corriger, n'hésite(z) pas à le faire savoir.

Le tableau des gradations de couleurs en fonction des % est évidemment adaptable et extensible à souhait.

Edit: 21h07 modification du code pour ne pas afficher les codes départements dans des Shapes qui ont un équivalent Zoom
Edit: 21h21 modification du code pour l'affectation directe de la couleur au lieu de passer par une décomposition RGB.
Edit: 06h15 modification du centrage de l'affichage des codes départements 54 et 92 pour mieux faire apparaitre le texte.

Bonjour , je reviens vers vous car je suis en train d'utiliser le fichier mais j'ai besoin, s'il vous plait, d'une petite variante: Si le %tage d'un département est vide alors je souhaite ne pas mettre de couleur dedans. Dés que la cellule est renseignée à partir de 0%, on démarre sur une couleur. Ci joint la PJ . Pouvez vous svp m'aider à finaliser? Merci par avance

 

[job75]

Bonjour pascaleg80, le fil,

C'est un peu du réchauffé, la moindre des choses serait de revenir avec un fichier qui fonctionne.

A+

 

[pascaleg80]

Bonjour pascaleg80, le fil,

C'est un peu du réchauffé, la moindre des choses serait de revenir avec un fichier qui fonctionne.

A+

Désolée de déranger.....

 

[job75]

Désolée de déranger....

Pas de dérangement mais les répondeurs ne savent pas forcément de quoi il s'agit.

 

[pascaleg80]

Pas de dérangement mais les répondeurs ne savent pas forcément de quoi il s'agit.

OK, j'ai prévu pour info une formation VDA et MACRO pour la rentrée pour maitriser parfaitement le sujet mais pour le moment j'ai besoin de votre aide afin de rendre mon projet dans les temps.

 

[pascaleg80]

Merc

Bonjour,
Une petite modif et ça le fait.
D.

Merci infiniment...... Vivement ma formation ;-)