Insertion carte de France + coloration selon données.

[Igl0]

Bonjour à tous,
Je souhaite avoir sur un document excel une carte de France sur laquelle les départements sont colorés selon le nombre de fois ou il a été visité (du rouge au vert, avec un changement de couleur tous les 10 ou 15).
Les données se présentent sous la forme, par exemple, A1=Num_du_dpt et A2=Nb_de_visite.

J'ai trouvé ça dans le forum qui me semblait pas mal, mais pas adapté à ce que je veux faire.

Quelqu'un aurait une idée ?

Merci.

 

[Igl0]

Re : Insertion carte de France + coloration selon données.

Voici le code. Il me semblait que ça découpait l'échelle selon un nombre de parts de taille égale, mais pas selon les pourcentages cités plus haut.

Sub ColorMap()
    Dim oSheet As Excel.Worksheet    ' Feuille
    Dim lLine As Long    ' Numéro de ligne
    Dim loShape As Shape    ' Forme
    Dim lColor As Long    ' Couleur
    Dim Gap As Long     ' Echelle
    Gap = Int(Application.Max(Range("B:B")) / 8)
    If Gap = 0 Then Gap = 1
' Feuille contenant la carte
    Set oSheet = ThisWorkbook.Sheets("Répartition")
    ' Désactive le remplissage de la carte
    oSheet.Shapes("CarteFrance").Fill.Visible = msoFalse
    ' Pour chaque ligne de Visites
    For lLine = oSheet.UsedRange.Row + 1 To oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count
        If oSheet.Cells(lLine, 2) >= "" Then lColor = vbWhite
        If oSheet.Cells(lLine, 2) >= 1 And oSheet.Cells(lLine, 3) <= Gap Then lColor = vbWhite
        If oSheet.Cells(lLine, 2) >= Gap + 1 And oSheet.Cells(lLine, 3) <= 2 * Gap Then lColor = 13209
        If oSheet.Cells(lLine, 2) >= 2 * Gap + 1 And oSheet.Cells(lLine, 3) <= 3 * Gap Then lColor = 255
        If oSheet.Cells(lLine, 2) >= 3 * Gap + 1 And oSheet.Cells(lLine, 3) <= 4 * Gap Then lColor = 39423
        If oSheet.Cells(lLine, 2) >= 4 * Gap + 1 And oSheet.Cells(lLine, 3) <= 5 * Gap Then lColor = 65535
        If oSheet.Cells(lLine, 2) >= 5 * Gap + 1 And oSheet.Cells(lLine, 3) <= 6 * Gap Then lColor = 52749
        If oSheet.Cells(lLine, 2) >= 6 * Gap + 1 And oSheet.Cells(lLine, 3) <= 7 * Gap Then lColor = 52377
        If oSheet.Cells(lLine, 2) >= 7 * Gap + 1 And oSheet.Cells(lLine, 3) <= 8 * Gap Then lColor = 26637
        If oSheet.Cells(lLine, 2) >= 8 * Gap + 1 Then lColor = 16763904

        ' Parcours les départements de la carte
        For Each loShape In oSheet.Shapes("CarteFrance").GroupItems
            ' Si la forme loShape a pour nom la valeur de la première colonne (l'identifiant FR-XX)
            If loShape.Name = oSheet.Cells(lLine, 1) Then
                ' Réactive le remplissage de la forme
                loShape.Fill.Visible = True
                ' Type de remplissage = couleur unie
                loShape.Fill.Solid
                ' Pas de transparence
                loShape.Fill.Transparency = 0#
                ' Couleur de remplissage
                loShape.Fill.ForeColor.RGB = lColor
                ' La forme a été trouvée => on sort de la boucle
                Exit For
            End If
        Next
    Next
    For t = 1 To 9
      Cells(35 + t, 3) = "'" & Gap * (t - 1) & "-" & Gap * t
    Next t
End Sub

 

[JCGL]

Re : Insertion carte de France + coloration selon données.

Bonjour à tous,

Pose tout pendant une journée... Ceci n'est pas le code que j'ai proposé...

A + à tous

 

[Igl0]

Re : Insertion carte de France + coloration selon données.

Exact, erreur de ma part, c'est le code de Softmama... Peux-tu me faire voir ton code ?

 

[Softmama]

Re : Insertion carte de France + coloration selon données.

Bonjour,

Exact, erreur de ma part, c'est le code de Softmama... Peux-tu me faire voir ton code ?

Houlà, je l'ai changé depuis un bon moment déjà ce code ^^.

 

[Igl0]

Re : Insertion carte de France + coloration selon données.

Et bien, dans quel fichier est le code mis à jour ? Je ne le trouve pas... :/