Créer une carte de France avec les dessins de formes libres [Tutoriel]

**audalice** · 25/04/2012, 14h34

Article très utile.
J'ajoute ma pierre à l'édifice en joignant un fichier réalisé à partir d'une carte monde au format SVG qui pourra je l'espère servir à d'autres.
Quelques petites restrictions cependant :
- certains petits pays ou territoires ne sont pas recensés sur la carte initiale et donc non présents dans les formes libres,
- certains pays sont ont été générés en plusieurs formes donc j'ai ajouté un indice après le nom des pays en question (par exemple la France génère deux formes libres : une pour la métropole et une autre pour la Corse appelées France1 et France 2; Autre exemple, le Canada génère à lui seul plus de 20 formes).
Bonnes cartographies

**Arkham46** · 25/04/2012, 21h22

Merci audalice (et SkyCorp même si ta contribution date un peu

) d'enrichir ce tutoriel avec vos oeuvres.

**Shou49** · 03/08/2012, 16h58

Bonjour,

Je souhaite adapter la méthode proposée dans le tutorial pour dessiner les cartes à partir de coordonnées de points uniquement.
Par exemple celle ci :

http://commons.wikimedia.org/wiki/Fi...h_Communes.svg

qui est définie par le code ci-dessous (un bout seulement) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
<?xml version="1.0" standalone="no"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" 
  "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
<svg width="1000" height="1132" viewBox="6.636038688 43.48006801 1.08008864 0.880988820000006"  preserveAspectRatio="none"
     xmlns="http://www.w3.org/2000/svg" version="1.1">
 
<style type="text/css" >
<![CDATA[
 
.communes { 
	fill           : #b9b9b9;
	fill-opacity   : 1;
	stroke         : white;
	stroke-opacity : 1;
	stroke-width   : 0.002;
}
 
]]>
</style>
 
<g transform="translate(0,44.36105683) scale(1,-1) translate(0,-43.48006801)">
 
<g class="communes">
 
<polygon id="06001 AIGLUN" points="6.959730874,43.83461863 6.931469881,43.83055995 6.912353878,43.83167131 6.917224786,43.85042666 6.907647691,43.86512356 6.90772519,43.86534604 6.920941341,43.86538524 6.936325028,43.87987843 6.94716225,43.87446794 6.952118009,43.86526897 6.960845316,43.86594348 6.951995685,43.85073056 6.959730874,43.83461863" />
<polygon id="06002 AMIRAT" points="6.791846922,43.87621184 6.781622233,43.88355825 6.801382125,43.91035137 6.832286437,43.91846082 6.835946727,43.915431 6.839386327,43.90949855 6.834813761,43.89394585 6.827300509,43.89022728 6.829692043,43.8839085 6.822108548,43.88097597 6.791846922,43.87621184" />
<polygon id="06003 ANDON" points="6.840408089,43.73087451 6.823995302,43.7371823 6.806967476,43.74849099 6.78442984,43.74782653 6.788022692,43.76454826 6.782448052,43.76991322 6.783219321,43.78006662 6.770032603,43.78336176 6.770597322,43.80587388 6.79402542,43.80855612 6.802311206,43.81211425 6.859033968,43.81987744 6.85936021,43.78307972 6.856102416,43.77441992 6.85776391,43.76458587 6.867986575,43.74994327 6.871942943,43.73421647 6.863334763,43.73609004 6.840408089,43.73087451" />
<polygon id="06004 ANTIBES" points="7.130086784,43.61779689 7.125891212,43.59569273 7.131328825,43.59063857 7.122942315,43.58674986 7.12902424,43.58273451 7.127076727,43.57186168 7.139943605,43.56968667 7.14239603,43.5514834 7.121594981,43.54386084 7.117586378,43.56463608 7.103008772,43.57129687 7.086497348,43.56982076 7.086586544,43.57315993 7.066117332,43.59031712 7.067593709,43.60658716 7.070199326,43.61220163 7.083283084,43.6083948 7.103497773,43.61675967 7.112829945,43.61684809 7.118001378,43.62254464 7.130086784,43.61779689" />
<polygon id="06005 ASCROS" points="7.049819699,43.90998391 7.045055741,43.91012456 7.036052639,43.89809458 7.020083597,43.90509101 7.005830584,43.90551605 6.993028032,43.9013807 6.990231934,43.91806311 6.972670495,43.9225784 6.978107284,43.92688587 6.980287089,43.93542993 7.009326094,43.93662918 7.045644138,43.92580044 7.059148033,43.9221361 7.049819699,43.90998391" />
<polygon id="06006 ASPREMONT" points="7.242460352,43.75129879 7.237656138,43.76380477 7.222428381,43.77110112 7.240046349,43.79167496 7.243991868,43.80141624 7.25355203,43.80063777 7.252738664,43.78670116 7.262404746,43.76702891 7.255457642,43.76240736 7.256417558,43.75559304 7.24863496,43.75158058 7.242460352,43.75129879" />
<polygon id="06007 AURIBEAU-SUR-SIAGNE" points="6.911990728,43.59833235 6.894469897,43.61102483 6.90249185,43.62341212 6.915475723,43.6239538 6.929108999,43.61659666 6.929398676,43.61340604 6.916719563,43.59878344 6.911990728,43.59833235" />

On voit bien que chaque commune est définie par une succession de points.

J'ai repris les coordonnées dans ma feuille de calcul comme ceci :

J'ai donc touché au code initial mais j'ai une erreur sur ConvertToShape... (erreur définie par l'application ou par l'objet). Cela plante à la ligne 61 du code ci dessous.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Option Explicit
 
'---------------------------------------------------------------------------------------------------------
' Importation du fichier SVG des départements et création des formes libres
'---------------------------------------------------------------------------------------------------------
Function CreateShapes()
Dim oSheet As Excel.Worksheet ' Feuille de travail
Dim lLine As Long ' Compteur de lignes
Dim lCoord As String ' Coordonnées du département
Dim lCptCoord As Long ' Compteur pour parcourir les coordonnées
Dim lCoordArray As Variant ' Coordonnées du département en tableau
Dim lNbShape As Long ' Nombre de formes créées
Dim lShapeRange() ' Tableaux des noms de formes créées pour fonction Group
Dim loFreeformBuilder As Excel.FreeformBuilder 'Constructeur de forme libre
 
' Feuille de données
Set oSheet = Sheets("Test")
' Parcourt la feuille des données
For lLine = 1 To 3
 
    ' Coordonnées
    lCoord = oSheet.Cells(lLine, 1)
    ' Mise en forme des coordonnées
    lCoord = Replace(lCoord, ",", " ")
    ' Crée un tableau à partir de la chaîne de caractères
    lCoordArray = Split(lCoord, " ")
    ' Initialise le compteur
    lCptCoord = LBound(lCoordArray)
 
    'Crée un constructeur de "forme libre" pour le département courant sur la feuille oSheet
    Set loFreeformBuilder = oSheet.Shapes.BuildFreeform(msoEditingCorner, Val(lCoordArray(lCptCoord)) * 10, Val(lCoordArray(lCptCoord + 1)) * 10)
 
    'Parcourir le vecteur coordonnées et ajouter les points
    While (lCptCoord < UBound(lCoordArray) - 2)
      lCptCoord = lCptCoord + 2
      loFreeformBuilder.AddNodes msoSegmentLine, msoEditingAuto, Val(lCoordArray(lCptCoord)) * 10, Val(lCoordArray(lCptCoord + 1)) * 10
    Wend
 
 
    ' Convertit le Constructeur en Forme
    With loFreeformBuilder.ConvertToShape 'ERREUR A L'EXECUTION A CETTE LIGNE
 
        ' Identifiant du département
        .Name = oSheet.Cells(lLine, 2)
        ' Incrémente le nombre de formes créées
        lNbShape = lNbShape + 1
        ' Redimensionne le tableau de formes créées
        ReDim Preserve lShapeRange(1 To lNbShape)
        ' Ajoute le nom de la forme au tableau pour groupement
        lShapeRange(lNbShape) = .Name
 
    End With
 
    ' Libère l'objet constructeur
    Set loFreeformBuilder = Nothing
 
 
Next
 
' Groupe les départements dans une forme
With oSheet.Shapes.Range(lShapeRange).Group
    .Name = "Carte"
    .ScaleHeight 0.05, msoFalse
    .ScaleWidth 0.05, msoFalse
    .LockAspectRatio = msoTrue
End With
End Function

Quelqu'un saurait pourquoi ?

Merci d'avance!

**éric1972** · 31/01/2013, 01h42

Bonjour, est ce que ce script mis plus haut fonctionne avec excel 2000?? parce que j'ai essayé d'appliquer la méthode avec un dessin dans inskape de 7 formes et cela fait planter excel qui ne fait que tourner en boucle. Si quelqu'un a déjà essayer sur excel 2000?

**TheGreyMustache** · 02/04/2013, 19h28

Bonjour,

merci pour ce fil très intéressant, notamment pour la carte multi couleurs. J'avais fait un premier essai avec un nombre de classes variables, reste la coloration. Il me reste à définir comment passer d'une échelle fixe de 15 couleurs à une échelle variable (de 5 à 15 classes), en fonction de l'échantillon.
Mais ceci est une autre histoire.
Ce qui m'amène, c'est la conversion d'une carte que j'ai retravaillée sous Inscape, intégrant les DOM.
Comme dans le message précédent, le traitement se plante, en raison du codage SVG retenu dans Inscape.

Je m'explique : quand une série de commandes est continue, le tableau de valeurs ne comprend que la commande initiale suivie du couple de valeurs.
Un exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

m 517.76892 448.70596 -2.84 1.91 0.39 1.88 1.51 1.91 -1.69 1.3 0.76 1.51 -1.15 1.33 v 1.69 l 1.91 1.73 v 2.63 l -1.15 2.45 -1.3 0.57 -1.51 -2.09 -2.66 0.21 -0.58 -0.39 h -2.27 l -2.06 1.91 -0.79 3.21 -4.9 0.94 -3.78 3.21 -0.76 2.09 -1.88 -0.18 -0.97 -1.15 -0.54 3.24 -1.33 0.54 -0.39 3.03 0.57 1.33 -2.09 1.51 -0.57 1.51 2.12 0.39 0.36 1.03 h 3.75 l 1.03 0.67 2.75 -0.51 1.18 0.7 -0.51 0.85 1.88 2.57 h 3.6 l 0.88 2.57 h 2.54 l -0.15 1.54 2.06 2.57 1.03 0.51 1.36 0.85 v 3.27 l 1.03 0.85 h 2.06 l 0.51 0.85 0.33 4.63 1.21 0.85 -0.51 0.7 0.33 2.72 3.93 -0.15 3.3 -2.18 -0.12 -5.6 4.54 -6.42 v -10.59 l -1.88 -3.6 -0.57 -11.35 -1.33 -2.09 -2.45 -1.88 -0.39 -7.02 1.15 -3.21 -1.51 -5.11 -0.94 -4.15 -0.79 -1.15 -1.71 -0.94 z

Du coup, le traitement se plante (cf message précédent - eric1972) sauf si on exécute en mode debug pour comprendre ce qui se passe.

Je réfléchis donc à une amélioration du traitement pour traiter ce cas, en intégrant en plus les H (ligne horizontale) et les V (ligne verticale).

Comme je sèche un peu

, si vous avez des idées pour avancer.

Encore merci.

**TheGreyMustache** · 08/04/2013, 12h08

Bonjour,

Le traitement a avancé. Par rapport au traitement initial proposé dans ce fil de discussion, je vous propose la version suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
'---------------------------------------------------------------------------------------------------------
' Importation du fichier SVG des départements et création des formes libres
'---------------------------------------------------------------------------------------------------------
Function CreateShapes()
Dim oSheet As Excel.Worksheet   ' Feuille de travail
Dim oMap As Excel.Worksheet     ' Feuille de la carte
 
Dim lLine As Long ' Compteur de lignes
Dim lCoord As String ' Coordonnées du département
Dim lCoordArray As Variant ' Coordonnées du département en tableau
Dim lLastX, lLastY As Variant
Dim lCptCoord As Long ' Compteur pour parcourir les coordonnées
Dim lNbShape As Long ' Nombre de formes créées
Dim lShapeRange() ' Tableaux des noms de formes créées pour fonction Group
Dim loFreeformBuilder As Excel.FreeformBuilder 'Constructeur de forme libre
Dim bCommand As Boolean
Dim tcommand As String
 
tcommand = "MZLHVCSQTA"
 
' Feuille de données
Set oSheet = Sheets("Departements2")
Set oMap = Sheets("Carte")
 
' Parcourt la feuille des données
For lLine = 101 To 201
    ' Coordonnées
    lCoord = oSheet.Cells(lLine, 1)
    ' Mise en forme des coordonnées
    lCoord = Replace(lCoord, ",", " ")
    ' Crée un tableau à partir de la chaîne de caractères
    lCoordArray = Split(lCoord, " ")
    ' Initialise le compteur
    lCptCoord = LBound(lCoordArray)
    Do
        Select Case UCase(lCoordArray(lCptCoord))
        Case "M" ' Point de départ
            ' Crée un constructeur de "forme libre" pour le département courant sur la feuille oSheet
            Set loFreeformBuilder = oMap.Shapes.BuildFreeform(msoEditingCorner, _
            Val(lCoordArray(lCptCoord + 1)) * 100, Val(lCoordArray(lCptCoord + 2)) * 100)
 
            lLastX = Val(lCoordArray(lCptCoord + 1))
            lLastY = Val(lCoordArray(lCptCoord + 2))
 
            lCptCoord = lCptCoord + 3
 
            bCommand = True
 
            Do While bCommand = True
                If InStr(1, tcommand, lCoordArray(lCptCoord), 1) = False Then
                    loFreeformBuilder.AddNodes msoSegmentLine, msoEditingAuto, _
                                Val(lCoordArray(lCptCoord)) * 100, Val(lCoordArray(lCptCoord + 1)) * 100
                    lLastX = Val(lCoordArray(lCptCoord))
                    lLastY = Val(lCoordArray(lCptCoord + 1))
                    lCptCoord = lCptCoord + 2
                Else
                    lCommand = UCase(lCoordArray(lCptCoord))
                    bCommand = False
                    Exit Do
                End If
            Loop
 
        Case "L" ' Segment
            loFreeformBuilder.AddNodes msoSegmentLine, msoEditingAuto, _
            Val(lCoordArray(lCptCoord + 1)) * 100, Val(lCoordArray(lCptCoord + 2)) * 100
 
            lLastX = Val(lCoordArray(lCptCoord + 1))
            lLastY = Val(lCoordArray(lCptCoord + 2))
 
            lCptCoord = lCptCoord + 3
 
            bCommand = True
 
            Do While bCommand = True
                If InStr(1, tcommand, lCoordArray(lCptCoord), 1) = False Then
                    loFreeformBuilder.AddNodes msoSegmentLine, msoEditingAuto, _
                                Val(lCoordArray(lCptCoord)) * 100, Val(lCoordArray(lCptCoord + 1)) * 100
                    lLastX = Val(lCoordArray(lCptCoord))
                    lLastY = Val(lCoordArray(lCptCoord + 1))
                    lCptCoord = lCptCoord + 2
                Else
                    lCommand = UCase(lCoordArray(lCptCoord))
                    bCommand = False
                    Exit Do
                End If
            Loop
 
        Case "V" ' Segment
            loFreeformBuilder.AddNodes msoSegmentLine, msoEditingAuto, _
                Val(lLastX) * 100, Val(lCoordArray(lCptCoord + 1)) * 100
 
            lLastY = Val(lCoordArray(lCptCoord + 1))
 
            lCptCoord = lCptCoord + 2
 
            bCommand = True
 
            Do While bCommand = True
                If InStr(1, tcommand, lCoordArray(lCptCoord), 1) = False Then
                    loFreeformBuilder.AddNodes msoSegmentLine, msoEditingAuto, _
                        Val(lLastX) * 100, Val(lCoordArray(lCptCoord)) * 100
 
'                    lLastX = Val(lCoordArray(lCptCoord))
                    lLastY = Val(lCoordArray(lCptCoord))
 
                    lCptCoord = lCptCoord + 1
                Else
                    lCommand = UCase(lCoordArray(lCptCoord))
                    bCommand = False
                    Exit Do
                End If
            Loop
 
 
        Case "H" ' Segment
            loFreeformBuilder.AddNodes msoSegmentLine, msoEditingAuto, _
            Val(lCoordArray(lCptCoord + 1)) * 100, Val(lLastY) * 100
 
            lLastX = Val(lCoordArray(lCptCoord + 1))
 
            lCptCoord = lCptCoord + 1
 
            bCommand = True
 
            Do While bCommand = True
                If InStr(1, tcommand, lCoordArray(lCptCoord), 1) = False Then
                    loFreeformBuilder.AddNodes msoSegmentLine, msoEditingAuto, _
                        Val(lCoordArray(lCptCoord)) * 100, Val(lLastY) * 100
                    lLastX = Val(lCoordArray(lCptCoord))
 
'                    lLastY = Val(lCoordArray(lCptCoord + 1))
                    lCptCoord = lCptCoord + 1
                Else
                    lCommand = UCase(lCoordArray(lCptCoord))
                    bCommand = False
                    Exit Do
                End If
            Loop
 
        Case "C" ' Courbe
            loFreeformBuilder.AddNodes msoSegmentCurve, msoEditingCorner, _
            Val(lCoordArray(lCptCoord + 1)) * 100, Val(lCoordArray(lCptCoord + 2)) * 100, _
            Val(lCoordArray(lCptCoord + 3)) * 100, Val(lCoordArray(lCptCoord + 4)) * 100, _
            Val(lCoordArray(lCptCoord + 5)) * 100, Val(lCoordArray(lCptCoord + 6)) * 100
 
            lLastX = Val(lCoordArray(lCptCoord + 5))
            lLastY = Val(lCoordArray(lCptCoord + 6))
 
            lCptCoord = lCptCoord + 7
 
            bCommand = True
 
            Do While bCommand = True
                If InStr(1, tcommand, lCoordArray(lCptCoord), 1) = False Then
                    loFreeformBuilder.AddNodes msoSegmentCurve, msoEditingCorner, _
                        Val(lCoordArray(lCptCoord)) * 100, Val(lCoordArray(lCptCoord + 1)) * 100, _
                        Val(lCoordArray(lCptCoord + 2)) * 100, Val(lCoordArray(lCptCoord + 3)) * 100, _
                        Val(lCoordArray(lCptCoord + 4)) * 100, Val(lCoordArray(lCptCoord + 5)) * 100
 
                    lLastX = Val(lCoordArray(lCptCoord + 4))
                    lLastY = Val(lCoordArray(lCptCoord + 5))
 
                    lCptCoord = lCptCoord + 6
                Else
                    lCommand = UCase(lCoordArray(lCptCoord))
                    bCommand = False
                    Exit Do
                End If
            Loop
 
 
        Case "Z" ' Fin de la forme
            ' Convertit le Constructeur en Forme
            With loFreeformBuilder.ConvertToShape
                ' Identifiant du département
'                .Fill.ForeColor.SchemeColor = 1
'                .Line.Weight = 0.25
                .Name = oSheet.Cells(lLine, 2)
                ' Incrémente le nombre de formes créées
                lNbShape = lNbShape + 1
                ' Redimensionne le tableau de formes créées
                ReDim Preserve lShapeRange(1 To lNbShape)
                ' Ajoute le nom de la forme au tableau pour groupement
                lShapeRange(lNbShape) = .Name
'                ActiveSheet.Shapes(lShapeRange(lNbShape)).Fill.BackColor.RGB = RGB(255, 255, 255)
            End With
            ' Libère l'objet constructeur
            Set loFreeformBuilder = Nothing
            ' Sort de la boucle de traitement des coordonnées
            Exit Do
        Case Else
            MsgBox "Commande non reconnue : " & UCase(lCoordArray(lCptCoord)) & "ligne : " & lLine
            Exit Do
        End Select
    Loop
Next
' Groupe les départements dans une forme
 
With oMap.Shapes.Range(lShapeRange).Group
    .Name = "CarteFrance"
    .ScaleHeight 0.05, msoFalse
    .ScaleWidth 0.05, msoFalse
    .LockAspectRatio = msoTrue
 
'    .Line.BackColor.SchemeColor = 0
 
End With
 
On Error Resume Next
    MsgBox "Erreur line : " & lLine & " - Commande - " & lCommand & " - point en cours : " & lCptCoord
 
End Function

Quelques modifications :

le * 100 ne change en rien par rapport à * 10.
J'ai intégré les commandes multiples c'est à dire :
La première commande est M qui définit le point de départ.
Quand plusieurs commandes M se suivent, les commandes suivantes doivent s'interpréter comme des commandes L.
J'ai intégré les commandes H (déplacement horizontal et V déplacement vertical), relatives au dernier point X ou Y en fonction du cas.
J'ai séparé en deux feuilles Département et Carte.
Le fichier SVG que j'ai créé est en points relatifs. Cela m'a posé pas mal de problèmes. Pour transformer un fichier SVG en points relatifs en fichiers en points absolus, il est nécessaire de modifier l'option Sortie SVG de Inscape et de décocher "Autorise les coordonnées relatives". Pour que votre fichier courant passe en coordonnées absolues, il est nécessaire de sélectionner l'ensemble du dessin (CTRL + A) puis de le déplacer eg. haut, bas, droite, gauche avant de le sauvegarder.

Par contre j'obtiens plusieurs aléatoires : parfois, le dessin de la Corse (exemple) n'est pas "bouclé". En fonction des essais, certains départements sont en bleu, d'autres en blanc, d'autres en transparent.
Enfin, j'obtiens systématiquement une erreur sur la ligne 2102 (dernière itération : mes données vont de 101 à 201.
La ligne "With oMap.Shapes.Range(lShapeRange).Group" ne s'exécute jamais, en cause de ma gestion des erreurs aléatoire certainement !

Si vous le souhaitez, je peux mettre à disposition mon fichier xlsm. Je veux bien amender le tuto proposé pour le faire évoluer.
J'ai laissé tomber temporairement la version en déplacement relatif. Ce sera pour une prochaine fois.

Par rapport à la carte multi couleurs, si quelqu'un peut m'aiguiller pour créer un gradient de couleurs variable en fonction du nombre de classes, je le remercie par avance.

La carte finale est relativement éloignée de la carte d'inscape : les départements ont une forme sensiblement différents pour certains. La Seine Maritime, bien que correctement définie chevauche l'Oise et la Somme. A replacer à la fin du traitement.

Je me propose de faire évoluer la carte multicolore pour y intégrer plus de variables.

A bientôt

merci

TGM

**Arkham46** · 08/04/2013, 14h41

Bonjour,

Effectivement, le tutoriel a été simplifié au maximum et ne donne pas le code pour gérer toute la spécification SVG.

Pour les bugs, vous pouvez joindre le classeur ou juste le svg à la discussion (bouton "gérer les pièce-jointes" lors de l'écriture d'un message).

Pour le dégradé, il faut passer en couleur HLS (teintes / luminance / saturation) pour appliquer un pourcentage entre les deux couleurs du dégradé :

Code à mettre dans un module standard :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Private Declare Sub ColorRGBToHLS Lib "shlwapi.dll" (ByVal clrRGB As Long, wHue As Integer, wLuminance As Integer, wSaturation As Integer)
Private Declare Function ColorHLSToRGB Lib "shlwapi.dll" (ByVal wHue As Integer, ByVal wLuminance As Integer, ByVal wSaturation As Integer) As Long
 
' Exemple : RGBGradient(vbyellow, vbblue, 0.4)
Public Function RGBGradient(pColor1 As Long, pColor2 As Long, pPercent As Double) As Long
Dim lRGB As Long
Dim lH1 As Integer, lS1 As Integer, lL1 As Integer
Dim lH2 As Integer, lS2 As Integer, lL2 As Integer
' Couleur verte
lRGB = vbGreen
' Calcul des teintes / luminance / saturation des 2 couleurs de début et fin du dégragé
ColorRGBToHLS pColor1, lH1, lL1, lS1
ColorRGBToHLS pColor2, lH2, lL2, lS2
' Calcul des teintes / luminance / saturation en fonction du pourcentage demandé
lH1 = lH1 + (lH2 - lH1) * pPercent
lL1 = lL1 + (lL2 - lL1) * pPercent
lS1 = lS1 + (lS2 - lS1) * pPercent
' Calcul de la couleur RGB du dégradé
RGBGradient = ColorHLSToRGB(lH1, lL1, lS1)
End Function

La fonction de test suivante coloe les 100 premières cellules d'une feuille avec un dégradé du jaune vers le bleu :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Function f1()
Dim i As Long
For i = 1 To 100
    ThisWorkbook.Sheets(1).Cells(i, 1).Interior.Color = RGBGradient(vbYellow, vbBlue, i / 100)
Next
End Function

**TheGreyMustache** · 08/04/2013, 15h37

Bonjour,

Merci pour votre réponse.

Je teste la partie couleur dès que possible.
Vous trouverez ci joint le fichier courant pour la génération des cartes.
la carte générée est légèrement différente de celle créée avec Inscape, certaines limites de département laissant des vides ou se chevauchant. Cela vient certainement des coordonnées de points avec des valeurs au millième ...

Les onglets sont les suivants :
Departements contient les coordonnées en relatif
Departements2 contient les coordonnées en absolu
Carte est l'onglet recevant la
CarteOK est la carte légèrement remaniée à la main (limites de département, repositionnement de la Seine Maritime)

J'ai renommé le fichier en XLS. Pour une utilisation avec les macro dans excel 2010, il doit être de type xlsm. J'ai fait un essai avec 2003 (j'ai les deux version) mais j'ai abandonné en cours de route ...

A votre disposition

Cordialement

**Arkham46** · 08/04/2013, 19h02

Re,

Pour les petits décalages : il ne faut pas utiliser Val sur les variables lLastX et lLastY (qui pourraient d'ailleurs être définies en Single :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim lLastX As Single, lLastY As Single

)
Val est utilisée pour transformer les données du svg du format texte vers du numérique.
Appliquer Val une deuxième fois retire la partie décimale (car Val s'applique sur du texte et ces variables sont des nombres ; donc par exemple un nombre 456.123 est transformé en texte 456,123, puis Val s'arrête à la virgule...).

Dans les AddNodes utilisant ces variables (pour les types V et H), remplacer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Val(lLastY)

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

lLastY

Idem pour lLastX.

C'est ensuite beaucoup mieux , les contours des départements se superposent bien.

Pour la Seine Maritime, voir dans le svg s'il n'y a pas une transformation de défini pour le chemin de ce département.

Et pour la gestion d'erreurs :
http://silkyroad.developpez.com/VBA/...nErreurs/#LIII

**TheGreyMustache** · 08/04/2013, 23h39

Effectivement, c'est beaucoup mieux ... même s'il reste quelques petites zouzouilles. J'avais fait le test en remplaçant tous les val(xxx*10) par les variables idoines. je regarderai si je peux encore améliorer le résultat, notamment en regardant de plus près mon fichier svg. Concernant la Seine Maritime elle semble bien positionnée. Si ça continue, je vais passer à la tortue logo ...

Par contre, je ne comprends pas l'erreur sur la dernière ligne (dernière itération + 1).

merci

**TheGreyMustache** · 09/04/2013, 17h17

Pour l'erreur, c'est OK ... il manque l'exit sub !
Je ne suis pas très doué en VBA ...

j'ai ajouté dans la carte St Pierre et Miquelon ... pour le moment surtout Miquelon !

Je vous tiens au courant de la suite.

**LUCAS33** · 14/06/2013, 18h03

Bonjour,

Merci tout d'abord pour ce tuto! J'ai besoin d'aide sur une partie du code. En effet dans la partie couleur "ColorMap" j'aimerais faire apparaître différentes couleurs en fonction de la force de progression.

Par exemple si j'ai un CA qui progresse de 10% un vert pétant, si il ne progresse que de 2% un vert clair pâle et la même chose (orange-rouge) pour le négatif.

Une idée?

Merci,
Lucas

**LUCAS33** · 19/06/2013, 16h40

Personne n'a de réponse? Un petit geste...

**fredmonard** · 19/06/2013, 19h54

Bonjour,
J'ai un fond de carte de France avec un découpage non départemental que je souhaiterai transformer en Shape office. Dois-je convertir ce fichier en vectoriel et ensuite utiliser la macro VBA ? C'est aussi simple que çà ? Merci

**Arnaud41** · 20/06/2014, 14h16

Bonjour,

J'ai testé le fichier carte de france, et j'y suis arrivé ;-)

Maintenant je voudrai faire une carte departementale avec les communes et les cantons.

Et la probleme, tous les fichiers SVG que je trouve ont les coordonnées mais sans les lette L M et v, du coup ça ne fonctionne pas (Voir Piece jointe).

Comment peut on faire la carte du Loir et Cher avec ses communes et ses cantons ?

@+ Arnaud

**la nouvelle** · 12/05/2015, 17h50

Bonjour
Le tuto est très bien fait. Cependant j'ai téléchargé un fichier svg mais il n'indique pas à quel département correspond les contours.
C'est écrit ca:
<path
style="fill:#d3ebfa;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
d="M 534.24683,374.89895 L 528.71034,380.32471 L 526.42465,387.09597 L 520.3125,389.21875 L 515.40625,403.125 L 495.8125,413.75 L 481.09375,413.75 L 432.0625,449.71875 L 357.6875,417.84375 L 298.03125,451.34375 L 302.9375,488.125 L 310.3125,497.09375 L 316.84375,502 L 316.03125,505.28125 L 311.9375,505.6875 L 312.24968,524.40102 L 308.49747,529.86364 L 297.05118,539.24076 L 285.65882,546.00093 L 273.09913,551.18086 L 273.38293,575.5 L 586.5,575.5 L 586.5,391.59423 L 575.20439,389.35544 L 561.14764,381.24358 L 544.06729,375.18352 L 534.24683,374.89895 z "
id="path2757" />

Merci

**RobinN** · 22/05/2015, 17h43

Bonjour à tous,

J'aimerai pouvoir afficher directement le CA sur le département et je n'y parviens pas, quelqu'un pourrait m'aider ?

Sinon, excellent tuto, très bien réalisé !!

Par ailleurs, est-il possible de hachurer les départements ? Par exemple, fond bleu et hachures en rouge, les hachures correspondant à une autre légende, bien sur.

**Ad3biz1** · 20/03/2017, 13h29

Bonjour,

Super boulot ! mais quand on est nul on est nul ....

J'ai aussi l'erreur 9 de la ligne 28, je pense que cela vient de mon fichier SVG. Je travaille sur une carte du monde.
1- je ne suis pas sur de la facon de gérer les pays aillant plusieurs blocs (comme la France avec ses DOM TOM, ou l'indonésie avec toutes ses iles). J'ai une ligne a chaque fois avec le meme ID ...
2- je n'ai pas systématiquement un Z à la fin de chaque description de forme...

Erreurs certainement trivials mais quand on est nul ....

Auriez vous une carte du monde, tt simplement? Pour le trvail des données les Macro données iront tres bien. Je vais continuer d'essayer en attendant de m'offrir la derbiere version d'Excel qui integre les cartes si j'ai bien compris ...

Merci par avance,

**jeanmidudu** · 16/01/2018, 17h53

Allez, pour le fun, je viens de passer sur le sujet, pas d'amélioration de la carte, mais une petite amélioration du "Jeu des départements". Rien de bien méchant, j'ai simplement ajouté l'affichage du n° de département, des noms de régions, des préfectures et sous-préfectures.

Departements metropole.xlsm

**Peslerbes** · 30/10/2018, 15h46

Tout d'abord un grand merci pour ce TUTO.
J'ai donc utilisé le tuto pour faire ma carte de ma région la Bretagne.
Cela fonctionne bien.
J'ai une question cependant. J'ai récupérer via une image vectorielle un .SVG sur internet. J'ai trouvé un SVG pour ma région et un SVG pour les 4 départements de ma région. Ces deux images virtuelles étant en libre service.
J'aimerais maintenant créer des cartes sur des zones géographiques plus détaillées. L'idéal pour moi c'est une image vectorielle de la région Bretagne mais par commune. Savez-vous s'il existe ce genre d'image en SVG en libre service sur internet.

Merci pour votre aide

Jacques

Créer une carte de France avec les dessins de formes libres [Tutoriel]

Microsoft Office

Discussions similaires

Partager

Partager