Amélioration carte Choroplèthe avec utilisation données géographiques Excel
Bonjour à toutes et tous,
Je cherche à améliorer le rendue visuelle d'une carte choropléthe que j'ai créée avec une base mise sous forme de tableau comportant notamment des données géographiques.
Je ne suis pas un expert des graphiques Excel et encore moins sous sa forme carte Choroplèthe.
Pourriez vous à l'aide du fichier joint m'aider à améliorer cette représentation au format carte ?
Peut être que la sélection de la série de données elle même est à revoir.
Merci
Très cordialement
Hugues
Bonjour,
Dans votre message, vous n'avez pas indiqué comment repérer vos villes sur la carte. Bien que cela n'ait rien à voir, le mécanisme correspond exactement à ce qui est décrit dans ce message Créer des points sur un diagramme.
Vous aurez vite compris la correspondance avec votre projet. Le principe est simple, dans le cas pris en exemple on identifie deux points de référence situés au Nord-Ouest et au Sud-Est et on extrapole la position des points par rapport à ces points.
Pour les cartes, il vaut mieux faire une représentation sur deux axes Ouest-Est, Nord-Sud correspondant aux points rouges sur la carte.
En mettant votre carte en cellule A1 d'un onglet Carte, le positionnement des points serait celui-ci :
Le nom des shapes correspondant à la colonne Point sur la carte, vous pouvez récupérer les coordonnées X carte et Y carte par ce code :
Sub EssaiRecupererLesCoordonneesXEtYSurLaCarte()
RecupererLesCoordonneesXEtYSurLaCarte Sheets("Carte")
End Sub
Sub RecupererLesCoordonneesXEtYSurLaCarte(ByVal FeuilleCarte As Worksheet)
Dim AireReferences As Range, CelluleReferences As Range
Dim ShapeReference As Shape
Set AireReferences = Range("t_References[Point sur la carte]")
Range(AireReferences.Offset(0, 4), AireReferences.Offset(0, 5)).ClearContents
For Each CelluleReferences In AireReferences
If FeuilleCarte.Shapes.Count > 0 Then
For Each ShapeReference In FeuilleCarte.Shapes
If ShapeReference.Name = CelluleReferences Then
CelluleReferences.Offset(0, 4) = ShapeReference.Left
CelluleReferences.Offset(0, 5) = ShapeReference.Top
ShapeReference.Visible = msoTrue
End If
Next ShapeReference
End If
Next CelluleReferences
Set AireReferences = Nothing
End SubLe référentiel utilisé par Bing pour positionner les villes sur votre tableau correspond aux coordonnées Google Maps. Il vous suffit donc d'extrapoler vos coordonnées selon les axes de référence.
En ce qui concerne la représentation des données sur la carte, tout dépend du nombre étant donné la taille de la carte. De mon point de vue, il vous faudra un cercle et un rectangle groupés. Me concernant, je resterais sur le cercle en lui donnant une couleur différente, le nom du point comportant le nom de la ville, il serait très simple de l'identifier avec le volet Sélection comme dans cette capture.
Bonjour Eric,
Je commence par vous remercier d'avoir pris du temps pour m'aider dans mon projet.
Il me faut maintenant bien comprendre votre proposition car j'avoue honnêtement en première lecture ne pas avoir tout assimiler; je vais commencer par intégrer la macro en suivant votre procédure. Et en testant peut être que j'arriverais à mieux comprendre je vous cite "Il vous suffit donc d'extrapoler vos coordonnées selon les axes de référence".
De nouveau merci, car manifestement vous me confirmer que mon projet est réalisable donc je continue d'essayer et me permettrais de revenir sur ce post pour partager mes avancées et aussi vous solliciter de nouveau sur les points de blocage forcément à venir.
Très cordialement
Hugues
Un exemple d'interpolation :
ValeurX et ValeurY sont les coordonnées des villes indiquées par Google Maps. On cherche PointX et PointY les coordonnées des points relativement aux paramètres de la carte qui sont chargés dans la matrice MatriceCarte. Dans cette matrice la première valeur 0 correspond aux coordonnées Google (colonnes 3 et 4 dans le tableau précédent), 1 correspond aux coordonnées de la carte sur l'onglet (colonnes 5 et 6 du tableau).
On peut choisir ensuite la représentation selon différentes formes et couleurs.
On relie la forme à sa donnée via un lien hypertexte.
Important : Il faut que le nom commence par un mot générique "Cercle", "Point", etc, pour supprimer par la suite les shapes sur la carte en testant la présence du mot.
Exemple de commande pour un point :
Mod2_CreerUneForme AireVilles(I), ShCarte, ValeurX2, ValeurY2, "A", 15, CouleurPointSub Mod2_CreerUneForme(ByVal CelluleBdd As Range, ByVal FeuilleCible As Worksheet, ByVal ValeurX As Double, ByVal ValeurY As Double, ByVal IdentifiantForme As String, ByVal TaillePoint1 As Double, CouleurPoint1 As Long)
Dim CreerHyperLien As Boolean
Dim PointCarte As Shape
Dim PointX As Double, PointY As Double
'Dim CelluleBdd As Range, AireBdd As Range
Dim NbPoints As Long
' Nord = 0, Sud = 1, Ouest = 2, Est = 3
' O = X Google, 1 = X écran
PointX = ((ValeurX - CDbl(MatriceCarte(0, 2))) / (CDbl(MatriceCarte(0, 3)) - CDbl(MatriceCarte(0, 2))) * (CDbl(MatriceCarte(1, 3)) - CDbl(MatriceCarte(1, 2)))) + CDbl(MatriceCarte(1, 2))
PointY = ((ValeurY - CDbl(MatriceCarte(0, 0))) / (CDbl(MatriceCarte(0, 1)) - CDbl(MatriceCarte(0, 0)))) * (CDbl(MatriceCarte(1, 1)) - CDbl(MatriceCarte(1, 0))) + CDbl(MatriceCarte(1, 0))
With FeuilleCible
' CreerHyperLien = False
' Select Case TypeDeForme
' Case "Cercle"
.Shapes.AddShape(msoShapeOval, PointX, PointY, TaillePoint1, TaillePoint1).Select
Selection.Name = "Cercle" & IdentifiantForme
CreerHyperLien = True
' Case "Carré"
' .Shapes.AddShape(msoShapeRectangle, PointX, PointY, TaillePoint1, TaillePoint1).Select
' Selection.Name = "Carre" & IdentifiantForme
' CreerHyperLien = True
' Case "Triangle"
' .Shapes.AddShape(msoShapeIsoscelesTriangle, PointX, PointY, TaillePoint1, TaillePoint1).Select
' Selection.Name = "Triangle" & IdentifiantForme
' CreerHyperLien = True
' Case "Losange"
' .Shapes.AddShape(msoShapeDiamond, PointX, PointY, TaillePoint1, TaillePoint1).Select
' Selection.Name = "Losange" & IdentifiantForme
' CreerHyperLien = True
' End Select
If CreerHyperLien = True Then
' For Each CelluleBdd In AireBdd
' If CelluleBdd = IdentifiantForme Then
FeuilleCible.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:="", SubAddress:="'" & FeuilleCible.Name & "'!" & CelluleBdd.Address, ScreenTip:=IdentifiantForme '"'Base de données'!A" & CelluleCoordonnee.Row
' Exit For
End If
' Next CelluleBdd
With Selection.ShapeRange
.Fill.ForeColor.RGB = CouleurPoint1
.Line.ForeColor.RGB = CouleurPoint1
End With
' End If
End With
End SubBonjour Eric, Toutes et tous,
Eric de nouveau merci.
Mais avant même de passer à la seconde partie de votre réponse je cale sur la mise en place de la première.
J'ai du mal interpréter la macro car il n'y à pas de résultats renvoyé pour X Carte et Y Carte.
Et enfin je lis et je relis vos réponses et je n'arrive pas indépendamment de mon problème à bien faire fonctionner la première macro comment à partir d'une liste de ville cela positionnera un repère sur ma carte.
Mais je continue d'essayer.
Merci
Très cordialement
Hugues
Bonjour toutes et tous, Bonjour Erik,
Erik même si je n'ai pas encore pu regarder de pré le fichier merci de cet envoi.
Je vous informe du suivi de votre aide sur mon projet, dès que le travail me laisse un peu de temps
Bien à vous,
Merci
Très cordialement
Hugues
Bonjour à toutes et tous, Bonjour Eric,
Eric, malgré un nombre d'heures important ce dimanche consacré à des essais de mise en place de votre proposition je n'ai pas réussi à la mettre en place.
En effet même si je comprend ce que vos codes sont censés faire (remplacer les shapes "les formes de la carte choropléthe symbolisant les villes) je n'arrive pas à l'intégrer à mon projet. Notamment parce que je ne maitrise pas VBA, je fonctionne par essai, tâtonnement et au mieux par déduction sans parfois comprendre la syntaxe et les instructions du code pour l'adapter à mon cas de figure.
La piste du graphique par nuage de points ou bulles, même si elle est la bonne à n'en pas douter, même en l'adaptant par le biais des coordonnées LAMBERT (conversion des données latitude et longitudes des données géographiques Excel) pour se passer d'une approche par macro ne me permet pas non plus de faire correspondre parfaitement les points avec la carte choroplèthe. cf fichier joint.
Je continue donc a tenter de trouver des solutions tout en restant à l'écoute de votre aide Eric ou d'autres personnes du forum.
Merci
Très cordialement,
Hugues
Bonjour,
Si le problème est de convertir des coordonnées Lambert en Wgs84, j'utilise ce site Geofree
L'exemple de représentation pour la commune Les Pieux :
Bonjour à toutes et tous, Bonjour Eric,
Eric, je ne me lasse pas de vous dire merci car grâce à vos apports je progresse et on s'approche d'une solution pour mon projet.
La partie conversion coordonnées GPS en Lambert, c'est ok sur le convertisseur, j'avais déjà un outil et finalement je ne m'appuie pas dessus.
J'ai effectivement compris comment paramétrer la macro pour représenter les villes sur la carte
With Sheets("Villes")
Mod2_CreerUneForme .Range("I2"), Sheets("Carte"), CDbl(.Range("G2").Value), CDbl(.Range("H2").Value), .Range("I2"), 8#, 6
Mod2_CreerUneForme .Range("I3"), Sheets("Carte"), CDbl(.Range("G3").Value), CDbl(.Range("H3").Value), .Range("I3"), 8#, 6
Mod2_CreerUneForme .Range("I4"), Sheets("Carte"), CDbl(.Range("G4").Value), CDbl(.Range("H4").Value), .Range("I4"), 8#, 6
End With(j'ai ainsi dans le fichier exemple Les Pieux, Carentan et Brest qui s'affiche,nt et je pourrais ainsi de suite rajouter d'autres villes, même si le temps sera proportionnel au nombres de données à saisir en dur pour chaque villes).
Je me pose les questions suivantes :
1 j'ai adapté la feuille Carte en modifiant affichage du graphique (suppression de la légende) ainsi que la mise en page pour impression j'ai donc adapté le positionnement des villes de références, celles en points rouges et récupérer via la macro RecupererLesCoordonneesXEtYSurLaCarte Sheets("Carte") les coordonnées Y et X que j'ai renseigné dans la macro RepresenterSurLaCarte()
' Coordonnées Y
MatriceCarte(0, 0) = 51.088851: MatriceCarte(1, 0) = 1.54
MatriceCarte(0, 1) = 42.435522: MatriceCarte(1, 1) = 502.58
' Coordonnées X
MatriceCarte(0, 2) = -4.773844: MatriceCarte(1, 2) = 17.37
MatriceCarte(0, 3) = 8.231051: MatriceCarte(1, 3) = 508.45Malgré cela la précision de la représentation des villes restent à affiner et plus particulièrement dans mon exemple pour Brest.
Sauriez vous comment je peux améliorer cette précision ? Ou ai je fais une erreur de modification du code ?
2 Est il possible de modifier le code (j'ai essayé mais cela à entrainer des bug sur d'autres parties du code, encore une fois je peux comprendre la logique mais je ne maitrise pas suffisamment les instruction VBA) pour automatiser la récupération des coordonnées de référence carte quand on déplace les points rouge pour recaler la carte par exemple :
' Coordonnées Y
MatriceCarte(0, 0) = 51.088851: MatriceCarte(1, 0) = Sheets("Références cartes").Range("F11").Value
MatriceCarte(0, 1) = 42.435522: MatriceCarte(1, 1) = Sheets("Références cartes").Range("F12").Value
' Coordonnées X
MatriceCarte(0, 2) = -4.773844: MatriceCarte(1, 2) = Sheets("Références cartes").Range("E13").Value
MatriceCarte(0, 3) = 8.231051: MatriceCarte(1, 3) = Sheets("Références cartes").Range("E14").Value3 Je pensais que le code effacer la shape générée par la carte chloropèthe pour une ville si représentée hors il semble que ce ce soit pas le cas
Est ce moi qui ai mal compris ce que le code est censé faire ou l'ai je mal adapté, si oui existe il un moyen de supprimer la shape de la carte Chlorophète si représentée, si non ou est mon erreur d'adaptation du code ?
Merci Eric, Merci toutes et tous
Très cordialement,
Hugues
Bonjour,
Pour mes cartes, je récupère les données sur ce site Coordonnées. Pour les coordonnées d'une commune le champ GeoPoint2D devrait suffire, sinon calculer le barycentre des coordonnées Geo_Shape. Nb : Votre carte a sans doute été établie avec les données de ce site.
Quel est votre problème de précision ? Sur une carte aussi petite, il ne faut pas en demander trop.
Pour la suppression des points des villes sur la cartes, le code suivant supprime ces points. Il faut pour cela qu'à la création du point, vous ayez défini un nom générique (chez moi : Cercle). Lorsque les 6 premiers caractères du nom de la forme sont trouvés, la forme est supprimée.
Sub SupprimerLesFormes(ByVal FeuilleCible As Worksheet, ByVal TypeShape As String)
Dim I As Integer
With FeuilleCible
If .Shapes.Count = 0 Then Exit Sub
For I = .Shapes.Count To 1 Step -1
With .Shapes(I)
If Mid(.Name, 1, 6) = TypeShape Then .Delete
End With
Next I
End With
End SubJe n'ai pas compris pourquoi il fallait supprimer la forme de la carte. Si elle n'est pas adaptée à ce que vous souhaitez faire, vous en créez une autre sur un autre onglet et vous complétez le tableau des paramètres des cartes.
Bonjour Eric et à toutes et tous,
Eric, même si je n'ai pas encore répondu à votre dernier post, je travaille toujours sur le sujet et quand mon emploi du temps me le permet de continuer à faire mes essais et mes tests.
Je reviendrais prochainement vers vous afin de lever les dernières interrogations et ainsi taguer en résolu ce post car Eric vos propositions sont bientôt proches de ma solution attendue.
Merci
Très cordialement
Hugues
Bonjour,
Pour information, je ne suis pas disponible en ce moment.