Code pour la réation d'une carte CHOROPLETHE

Bonjour.

Je dispose d'un fichier texte que j'importe dans une feuille excel sous forme de tableau à trois colonnes:

Colonne 1 : Pays (Algérie)

Colonne 2 : Provinces (Toutes les provinces d' Algérie)

Colonne 3 : Valeur ( Température, humidité, ou autre paramètre numérique)

Je voudrais donc créer une carte CHOROPLETHE via un code VBA en précisant trois couleurs pour les différentes formes ou profinces constituant la carte selon la valeur du paramètre correspondant.

Je compte sur l'aide de tous pour m'aider à réaliser ce travail avec mes vifs remerciements d'avance.

Bonne chance à ce merveilleux site

A.Said

Hello,

En pièce jointe un classeur avec une carte choroplèthe des provinces de l'Algérie. La carte vectorielle d'origine svg provient d'ici ( licence MIT , mise à jour avec les 69 provinces). La carte svg a été transformée en emf avec Inkscape (pour pouvoir l'importer dans Excel 2016 qui ne lisait pas les svg). La carte a été dissociée (pour avoir une forme par province). La carte se trouve dans la feuille Carte.

Dans la feuille Data il y a des données avec les colonnes suivantes :

• A - code de la province
• B - Nom de la province
• C - Nom Latin
• D - Nom Arabe
• E - Températures Fictives

Dans la Feuille Carte il y a deux boutons :

1 - Pour colorer la carte en fonction de la température

2 - Pour remettre la couleur par défaut.

Voici le code VBA pour colorer les provinces (à adapter pour changer les couleurs où les valeurs de seuil des couleurs) :

Sub ColorerProvinces()

    Dim wsData As Worksheet
    Dim wsCarte As Worksheet
    Dim derniereLigne As Long
    Dim i As Long
    Dim numeroFreeform As Long
    Dim nomFreeform As String
    Dim temperature As Double
    Dim shp As Shape

    Set wsData = ThisWorkbook.Worksheets("Data")
    Set wsCarte = ThisWorkbook.Worksheets("Carte")

    ' Dernière ligne des données
    derniereLigne = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row

    For i = 2 To derniereLigne

        ' Ligne 2 = Freeform 4
        numeroFreeform = i + 2
        nomFreeform = "Freeform " & numeroFreeform

        ' Vérifie qu'une température est présente
        If IsNumeric(wsData.Cells(i, "E").Value) _
           And wsData.Cells(i, "E").Value <> "" Then

            temperature = CDbl(wsData.Cells(i, "E").Value)

            ' Recherche la Freeform dans la carte groupée
            Set shp = TrouverFreeform(wsCarte, nomFreeform)

            If Not shp Is Nothing Then

                ' Couleur selon la température
                Select Case temperature

                    Case Is < 20
                        shp.Fill.ForeColor.RGB = RGB(0, 102, 204)

                    Case 20 To 24.99
                        shp.Fill.ForeColor.RGB = RGB(102, 178, 255)

                    Case 25 To 29.99
                        shp.Fill.ForeColor.RGB = RGB(102, 204, 102)

                    Case 30 To 34.99
                        shp.Fill.ForeColor.RGB = RGB(230, 230, 0)

                    Case 35 To 39.99
                        shp.Fill.ForeColor.RGB = RGB(255, 153, 0)

                    Case Is >= 40
                        shp.Fill.ForeColor.RGB = RGB(255, 0, 0)

                End Select

                ' Contour invisible (msoFalse)
                With shp.Line
                    .Visible = msoFalse
                    .ForeColor.RGB = RGB(100, 100, 100)
                    .Weight = 0.5
                End With

            End If

            Set shp = Nothing

        End If

    Next i

    Debug.Print "Carte mise à jour !", vbInformation

End Sub

Ami calmant, J.P

Bonjour à tous,

@JP petite question : combien de temps passes-tu, environ, à convertir/découper/importer/placer la carte/shapes ? Est-ce manuel ou automatique ? Merci

@JP petite question : combien de temps passes-tu, environ, à convertir/découper/importer/placer la carte/shapes ? Est-ce manuel ou automatique

Hello,

c'est très rapide si la carte d'origine est bien faite. La svg d'origine était bien découpée en formes ayant comme nom le code de la province . La conversion dans InkScape en Emf est instantané puisqu'il suffit de faire Enregistrer sous. L' importation dans Excel en image est instantané, il suffit de faire dissocier pour se trouver avec un groupe qui contient toutes les formes des provinces. Les formes sont nommées par défaut (Freeform xx) mais avec le même ordre apparemment que l'ordre dans lequel elles étaient dans le svg donc on peut faire la correspondance Code Province - Forme. Sinon on peut "s'amuser" à renommer les formes d'après leur Code Province ( c'est plus long bien que dans le cas présent on puisse certainement le faire automatiquement) . Il est préférable de verrouiller les formes pour éviter de les déplacer accidentellement. Sinon on peut jouer sur le zoom de la feuille pour avoir la carte en entier dans la feuille .

Ami calmant, J.P

Bon j'ai réussi à renommer automatiquement les formes Province avec comme nom leur code. Et pour la protection des formes Province comme ils sont dans un groupe, c'est le groupe qui est accessible dans la feuille. Pour sélectionner une forme province, il faut utiliser le volet de sélection.

Grand merci chers ami(e)s pour vos solutions proposées.

Je repose mon problème :

Disposant d'un tableau de données comportant trois colonnes dans une feuille excel (excel 2021), dont :

Colonne A : "Algérie"

Colonne B : Province ("Alger", "Oran","Annaba",etc)

Colonne C : Température (Valeur numérique positive ou négative)

En selectionnant les trois colonnes, et cliquant sur le bouton INSERTION puis sur CARTE CHOROPLETHE, la carte s'affiche convenablement sur mon écran avec un seul inconvéniant "la couleur des provinces attribuée automatiquement par le système et pas comme on le souhaite, Exemple : un dégradé allant du bleu au rouge pour les valeurs de température,etc..."

Mon voeu est donc de réaliser un code VBA pour réaliser ce travail de développement.

Encore, merci d'avance.