Créer une carte de france avec les dessins de formes libres [Article]

[audalice]

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ésent 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]

Merci audalice (et SkyCorp même si ta contribution date un peu ) d'enrichir ce tutoriel avec vos oeuvres.

[Shou49]

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 :

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 :

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]

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]

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 :

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]

Bonjour,

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

Code :

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]

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 :

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 :

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]

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]

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 :

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 :

Val(lLastY)

par

Code :

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]

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]

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.