URL Trop long (Google Map API)
Bonjour, bonjour !
Je suis à la recherche d'une idée brillante pour réduire au maximum la taille de l'url pour afficher une Google Map. Car comme vous le savez tous (ou pas), la longueur d'un URL est limité à 2083 caractères, ce qui, dans la majorité des cas est largement suffisant, mais ici assez restrictif...
Je m'explique, j'ai un tableau avec environ 300 adresses (bientôt), et je veux les indiquer par un petit marqueur sur Google Map.
Problème : J'entre la rue, le code postal, la ville et cela prend beaucoup trop de caractères...
Si j'enlève la ville (et laisse CP et Rue) je peux me retrouver à l'étranger, et pareil si j'enlève CP (et laisse Ville et Rue).
J'ai songé à utiliser latitude/longitude mais je ne sais pas vraiment comment les récupérer par un code..
(Actuellement je n'ai que 121 adresses, et j'en suis déjà à 4751 caractères... Même en divisant par 2 le nombre de caractères je ne pourrais pas afficher de google map.)
J'attends donc de vous une solution miracle, un sortilège, voire une potion magique (j'accepte toutes formes d'aide lol).
Merci à ceux qui se pencheront sur le sujet, et j'espère qu'une solution miracle réside en l'un de vous.
Sur ce, bonne journée à tous !
BONJOUR
Pouvez vous menvoi un petit extrait de ton fichier comme exemple
Bonjour,
réduis en mettant latitude et longitude uniquement
Re AMIR, Steelson,
@AMIR c'est compliqué, mon fichier est trop volumineux.
@Steelson J'y ai pensé, mais comment récupérer latitude/longitude de mes adresses automatiquement? (Parce que je ne compte pas ajouter les coordonnées manuellement).
Bonjour:
Proposition en deux étapes:
1) Pour toutes tes adresses faire une requête sur google map avec le Webbrower disponible dans Excel.
ex: https://www.google.fr/maps/place/Gare+du+Nord
Automatiquement l'URL va changer et devenir quelque chose de ce genre :
https://www.google.fr/maps/place/Gare+du+Nord,+18+Rue+de+Dunkerque,+75010+Paris/@48.8809481,2.353125,17z*********** Il suffit alors d'extraire de l'URL les coordonnées
2) Quand tu as toutes les latitutes/longitudes -> tu crée ta big requête (il faudra m'indiquer comment tu fais actuellement pour ajouter plusieurs points dans ton URL!)
Si besoin, tu simplifies les latitudes/longitudes en fonction de la précision que tu souhaites!!
48.8809481,2.353125 pourrait être rendu en 48.88,2.35 et toujours être pertinent pour ton besoin.
À la limite j'peux mettre mon code:
[u]
GOOGLE MAP[/u]
' ************************************************************
' * *
' * Procédure d'affichage d'une Google Map *
' * *
' * *
' ************************************************************
Private Sub GoogleMap_Click()
' Variables permettant la construction de l'URL
' J'ai choisi cette solution qui peut paraître comme n'étant pas la meilleure
' Cependant elle permet de minimiser le nombre de caractères de l'URL
Dim Adresse As Variant
Dim Adresse54 As Variant
Dim Adresse55 As Variant
Dim Adresse57 As Variant
Dim Adresse88 As Variant
Dim AdresseAutre As Variant
Dim AdresseLux As Variant
Dim NumRue As String
Dim NomRue As String
Dim CodePostal As String
Dim Ville As String
Dim Pays As String
Dim i As Integer
Dim dernièreLigne As Integer
' Encore une fois, ces variables permettent l'optimisation du nombre de caractères dans l'URL
' En effet, elles comptent le nombre de client dans chaque région
' Et si jamais il n'y en a aucun d'en l'une d'entre elles, alors cela évite d'écrire un bout d'URL inutile
Dim compteur54 As Integer
Dim compteur55 As Integer
Dim compteur57 As Integer
Dim compteur88 As Integer
Dim compteurAutre As Integer
Dim compteurLux As Integer
' Sert à identifier la dernière ligne contenant des informations
dernièreLigne = Sheets("Tableau CEC").Cells(Rows.Count, 1).End(xlUp).Row
' Initialisation des compteurs à 0
compteur54 = 0
compteur55 = 0
compteur57 = 0
compteur88 = 0
compteurAutre = 0
compteurLux = 0
' Le début de l'URL constant
Adresse = "https://maps.googleapis.com/maps/api/staticmap?center=Thionville&size=640x640&scale=2"
' Boucle qui va fouiller le tableau pour récupérer l'adresse de chacun des clients
For i = 2 To dernièreLigne
NumRue = Sheets("Tableau CEC").Cells(i, 4)
NomRue = Sheets("Tableau CEC").Cells(i, 5)
CodePostal = Sheets("Tableau CEC").Cells(i, 7)
Ville = Sheets("Tableau CEC").Cells(i, 8)
Pays = Sheets("Tableau CEC").Cells(i, 9)
' Test si le nom de rue du client comporte un caractère spécial afin de le remplacer par un équivalent accepté par Internet Explorer
If InStr(NomRue, "&") > 0 Or InStr(NomRue, "ç") Or InStr(NomRue, "Ç") > 0 Then
NomRue = sansCaracSpé(NomRue)
End If
' Test si la ville du client comporte un caractère spécial afin de le remplacer par un équivalent accepté par Internet Explorer
If InStr(Ville, "&") > 0 Or InStr(Ville, "ç") Or InStr(Ville, "Ç") > 0 Then
Ville = sansCaracSpé(Ville)
End If
' Différentes écritures d'adresses selon le Pays
Select Case Pays
Case "France"
' Différentes écritures d'adresses selon le Code Postal
Select Case CodePostal
Case 54000 To 54999
Adresse54 = Adresse54 & "|'" & NumRue & " " & NomRue & " " & CodePostal & " " & Ville & "'"
compteur54 = compteur54 + 1
Case 55000 To 55999
Adresse55 = Adresse55 & "|'" & NumRue & " " & NomRue & " " & CodePostal & " " & Ville & "'"
compteur55 = compteur55 + 1
Case 57000 To 57999
Adresse57 = Adresse57 & "|'" & NumRue & " " & NomRue & " " & CodePostal & " " & Ville & "'"
compteur57 = compteur57 + 1
Case 88000 To 88999
Adresse88 = Adresse88 & "|'" & NumRue & " " & NomRue & " " & CodePostal & " " & Ville & "'"
compteur88 = compteur88 + 1
Case Else
AdresseAutre = AdresseAutre & "|'" & NumRue & " " & NomRue & " " & CodePostal & " " & Ville & "'"
compteurAutre = compteurAutre + 1
End Select
Case "Luxembourg"
AdresseLux = AdresseLux & "|'" & NumRue & " " & NomRue & " " & CodePostal & " " & Ville & "'"
compteurLux = compteurLux + 1
End Select
Next i
' Série de test sur l'existence de clients dans chaque région pour le soucis d'optimisation de l'URL évoqué plus haut
' Changement de la couleur du marqueur en fonction du code postal (Ceci explique l'utilisation des Select Case)
If compteur54 > 0 Then
Adresse = Adresse & "&markers=color:green|size:mid" & Adresse54
End If
If compteur55 > 0 Then
Adresse = Adresse & "&markers=color:orange|size:mid|" & Adresse55
End If
If compteur57 > 0 Then
Adresse = Adresse & "&markers=color:blue|size:mid|" & Adresse57
End If
If compteur88 > 0 Then
Adresse = Adresse & "&markers=color:red|size:mid|" & Adresse88
End If
If compteurAutre > 0 Then
Adresse = Adresse & "&markers=color:purple|size:mid|" & AdresseAutre
End If
If compteurLux > 0 Then
Adresse = Adresse & "&markers=color:black|size:mid|" & AdresseLux
End If
' Retire tous les accents de l'URL afin d'être compatible avec Internet Explorer
Adresse = sansAccents(Adresse)
Debug.Print Adresse
Debug.Print Len(Adresse)
' Appel de la procédure permettant d'afficher une page web
Call AfficherPageWeb(Adresse)
End Sub
' ************************************************************
' * *
' * Procédure d'affichage d'une page web *
' * contenant une google map *
' * *
' ************************************************************
Public Sub AfficherPageWeb(ByVal url As String)
' Procédure permettant l'affichage d'une page web
Dim refIE As InternetExplorer
Set refIE = New InternetExplorer
refIE.Navigate url
With refIE
.Width = 1280
.Height = 640
.Left = 0
.Top = 0
End With
refIE.Visible = True
Set refIE = Nothing
End SubVala une proposition pour la recherche des coordonnées.
Re d3d9x,
Déjà merci pour ton aide.
Maintenant, je ne comprends pas vraiment ton code et en plus je vois pas pourquoi mais cela ne fonctionne pas. Lorsque j'appuie sur le Bouton 2, je reçois une erreur "Objet Recquis".
Pourtant j'ai bien écris une adresse dans la première colonne.
Je vois vraiment pas de résultat. Cependant il m'a tout de même l'air d'être intéressant s'il permet vraiment de récupérer les coordonnées en latitude/longitude.
Bonjour
essayer avec ca
Private Sub GoogleMap_Click()
' Variables permettant la construction de l'URL
' J'ai choisi cette solution qui peut paraître comme n'étant pas la meilleure
' Cependant elle permet de minimiser le nombre de caractères de l'URL
Dim Adresse() As Variant
Dim NumRue() As String
Dim NomRue() As String
Dim CodePostal() As String
Dim Ville() As String
Dim Pays() As String
Dim i As Integer, x As Integer
Dim derniereLigne As Integer
Dim compteur54 As Integer
Dim compteur55 As Integer
Dim compteur57 As Integer
Dim compteur88 As Integer
Dim compteurAutre As Integer
Dim compteurLux As Integer
derniereLigne = Sheets("Tableau CEC").Cells(Rows.Count, 1).End(xlUp).Row
ReDim Adresse(derniereLigne)
ReDim NumRue(derniereLigne)
ReDim NomRue(derniereLigne)
ReDim CodePostal(derniereLigne)
ReDim Ville(derniereLigne)
ReDim Pays(derniereLigne)
' Le début de l'URL constant
Adresse(1) = "https://maps.googleapis.com/maps/api/staticmap?center=ThionVille&size=640x640&scale=2"
' Boucle qui va fouiller le tableau pour récupérer l'adresse de chacun des clients
For x = 2 To derniereLigne
NumRue(x) = Sheets("Tableau CEC").Cells(x, 4)
NomRue(x) = Sheets("Tableau CEC").Cells(x, 5)
CodePostal(x) = Sheets("Tableau CEC").Cells(x, 7)
Ville(x) = Sheets("Tableau CEC").Cells(x, 8)
Pays(x) = Sheets("Tableau CEC").Cells(x, 9)
' ############### y a t il que "ç" ou "Ç" a craindre !? ##################
' Test si le nom de rue du client comporte un caractère spécial afin de le remplacer par un équivalent accepté par Internet Explorer
If InStr(NomRue(x), "&") > 0 Or InStr(NomRue(x), "ç") Or InStr(NomRue(x), "Ç") > 0 Then
NomRue(x) = sansCaracSpé(NomRue(x))
End If
' Test si la Ville(x) du client comporte un caractère spécial afin de le remplacer par un équivalent accepté par Internet Explorer
If InStr(Ville(x), "&") > 0 Or InStr(Ville(x), "ç") Or InStr(Ville(x), "Ç") > 0 Then
Ville(x) = sansCaracSpé(Ville(x))
End If
Next x
For x = 2 To derniereLigne
' Différentes écritures d'adresses selon le Pays
Select Case Pays(x)
Case "France"
' Différentes écritures d'adresses selon le Code Postal
Select Case CodePostal(x)
Case 54000 To 54999
Adresse(x) = Adresse(1) & "&markers=color:green|size:mid""|'" & NumRue(x) & " " & NomRue(x) & " " & CodePostal(x) & " " & Ville(x) & "'"
compteur54 = compteur54 + 1
Case 55000 To 55999
Adresse(x) = Adresse(1) & "&markers=color:orange|size:mid|" & "|'" & NumRue(x) & " " & NomRue(x) & " " & CodePostal(x) & " " & Ville(x) & "'"
compteur55 = compteur55 + 1
Case 57000 To 57999
Adresse(x) = Adresse(1) & "&markers=color:blue|size:mid|" & "|'" & NumRue(x) & " " & NomRue(x) & " " & CodePostal(x) & " " & Ville(x) & "'"
compteur57 = compteur57 + 1
Case 88000 To 88999
Adresse = Adresse(1) & "&markers=color:red|size:mid|" & "|'" & NumRue(x) & " " & NomRue(x) & " " & CodePostal(x) & " " & Ville(x) & "'"
compteur88 = compteur88 + 1
Case Else
Adresse(x) = Adresse(1) & "&markers=color:purple|size:mid|" & "|'" & NumRue(x) & " " & NomRue(x) & " " & CodePostal(x) & " " & Ville(x) & "'"
compteurAutre = compteurAutre + 1
End Select
Case "Luxembourg"
Adresse(x) = Adresse(1) & "&markers=color:black|size:mid|" & "|'" & NumRue(x) & " " & NomRue(x) & " " & CodePostal(x) & " " & Ville(x) & "'"
compteurLux = compteurLux + 1
End Select
Next x
' Retire tous les accents de l'URL afin d'être compatible avec Internet Explorer
Adresse(x) = sansAccents(Adresse(x))
Debug.Print Adresse(x)
Debug.Print Len(Adresse(x))
' Appel de la procédure permettant d'afficher une page web
Call AfficherPageWeb(Adresse(x))
End Subs il y des bugs dit moi
Il faut activer les activeX. à l'ouverture du fichier, il faut autoriser les macros ET les contrôles activeX.Remdu57 a écrit :Je reçois une erreur "Objet Recquis".
Re,
@AMIR
J'ai une erreur "L'indice n'appartient pas à la sélection" sur la ligne :
Adresse(x) = sansAccents(Adresse(x))@d3d9x
À l'ouverture de fichier on me propose juste d'activer les macros (chose que je fais). Rien ne mentionne les contrôles ActiveX, et même en fouillant dans les options j'ai toujours le problème "objet requis".
Salut
Cette ligne était hors ses limites
correction :
Private Sub GoogleMap_Click()
' Variables permettant la construction de l'URL
' J'ai choisi cette solution qui peut paraître comme n'étant pas la meilleure
' Cependant elle permet de minimiser le nombre de caractères de l'URL
Dim Adresse() As Variant
Dim NumRue() As String
Dim NomRue() As String
Dim CodePostal() As String
Dim Ville() As String
Dim Pays() As String
Dim i As Integer, x As Integer
Dim derniereLigne As Integer
Dim compteur54 As Integer
Dim compteur55 As Integer
Dim compteur57 As Integer
Dim compteur88 As Integer
Dim compteurAutre As Integer
Dim compteurLux As Integer
derniereLigne = Sheets("Tableau CEC").Cells(Rows.Count, 1).End(xlUp).Row
ReDim Adresse(derniereLigne)
ReDim NumRue(derniereLigne)
ReDim NomRue(derniereLigne)
ReDim CodePostal(derniereLigne)
ReDim Ville(derniereLigne)
ReDim Pays(derniereLigne)
' Le début de l'URL constant
Adresse(1) = "https://maps.googleapis.com/maps/api/staticmap?center=ThionVille&size=640x640&scale=2"
' Boucle qui va fouiller le tableau pour récupérer l'adresse de chacun des clients
For x = 2 To derniereLigne
NumRue(x) = Sheets("Tableau CEC").Cells(x, 4)
NomRue(x) = Sheets("Tableau CEC").Cells(x, 5)
CodePostal(x) = Sheets("Tableau CEC").Cells(x, 7)
Ville(x) = Sheets("Tableau CEC").Cells(x, 8)
Pays(x) = Sheets("Tableau CEC").Cells(x, 9)
' ############### y a t il que "ç" ou "Ç" a craindre !? ##################
' Test si le nom de rue du client comporte un caractère spécial afin de le remplacer par un équivalent accepté par Internet Explorer
If InStr(NomRue(x), "&") > 0 Or InStr(NomRue(x), "ç") Or InStr(NomRue(x), "Ç") > 0 Then
NomRue(x) = sansCaracSpé(NomRue(x))
End If
' Test si la Ville(x) du client comporte un caractère spécial afin de le remplacer par un équivalent accepté par Internet Explorer
If InStr(Ville(x), "&") > 0 Or InStr(Ville(x), "ç") Or InStr(Ville(x), "Ç") > 0 Then
Ville(x) = sansCaracSpé(Ville(x))
End If
Next x
For x = 2 To derniereLigne
' Différentes écritures d'adresses selon le Pays
Select Case Pays(x)
Case "France"
' Différentes écritures d'adresses selon le Code Postal
Select Case CodePostal(x)
Case 54000 To 54999
Adresse(x) = Adresse(1) & "&markers=color:green|size:mid""|'" & NumRue(x) & " " & NomRue(x) & " " & CodePostal(x) & " " & Ville(x) & "'"
compteur54 = compteur54 + 1
Case 55000 To 55999
Adresse(x) = Adresse(1) & "&markers=color:orange|size:mid|" & "|'" & NumRue(x) & " " & NomRue(x) & " " & CodePostal(x) & " " & Ville(x) & "'"
compteur55 = compteur55 + 1
Case 57000 To 57999
Adresse(x) = Adresse(1) & "&markers=color:blue|size:mid|" & "|'" & NumRue(x) & " " & NomRue(x) & " " & CodePostal(x) & " " & Ville(x) & "'"
compteur57 = compteur57 + 1
Case 88000 To 88999
Adresse = Adresse(1) & "&markers=color:red|size:mid|" & "|'" & NumRue(x) & " " & NomRue(x) & " " & CodePostal(x) & " " & Ville(x) & "'"
compteur88 = compteur88 + 1
Case Else
Adresse(x) = Adresse(1) & "&markers=color:purple|size:mid|" & "|'" & NumRue(x) & " " & NomRue(x) & " " & CodePostal(x) & " " & Ville(x) & "'"
compteurAutre = compteurAutre + 1
End Select
Case "Luxembourg"
Adresse(x) = Adresse(1) & "&markers=color:black|size:mid|" & "|'" & NumRue(x) & " " & NomRue(x) & " " & CodePostal(x) & " " & Ville(x) & "'"
compteurLux = compteurLux + 1
End Select
' Retire tous les accents de l'URL afin d'être compatible avec Internet Explorer
Adresse(x) = sansAccents(Adresse(x))
Debug.Print Adresse(x)
Debug.Print Len(Adresse(x))
' Appel de la procédure permettant d'afficher une page web
Call AfficherPageWeb(Adresse(x))
Next x
End SubRe,
@AMIR
Il est dangereux ce code, il va ouvrir autant de page internet explorer qu'il y a d'adresses dans mon tableau.
Une adresse = une google map : c'est pas vraiment l'effet recherché.
Personnellement je voudrais une google map avec tous les clients.
Merci en tout cas de consacrer du temps à mon problème.
Possibilité 1:
Active l'options. Ferme excel et relance le fichier
Possibilité 2: Joins moi toutes les adresses à récupérer.
bonjour
Il est dangereux ce code, il va ouvrir autant de page internet explorer qu'il y a d'adresses dans mon tableau.
Une adresse = une google map : c'est pas vraiment l'effet recherché.
Personnellement je voudrais une google map avec tous les clients.
Oui je sais
Les but était de réduire ton premier code par l utilisation de tableau et effacer les liges inutiles
J ai une question
pouvez vous ajouter les marques de chaqu'un manuelement tout en conservant les autre marquees bien sur on comencant par le premiere ....
pouvez vous le faire avec un code apres l ouverture d une page web "map"
d3d9x a écrit :Il faut activer les activeX. à l'ouverture du fichier, il faut autoriser les macros ET les contrôles activeX.Remdu57 a écrit :Je reçois une erreur "Objet Recquis".
Bonjour d3d9x, Remdu57
Ben j'ai le même soucis, en dépit de l'activation des controleX
J'ai contourné le difficulté et ai traité cela de façon artisanale ! (je n'ai pas encore le niveau, mais j'y travaille !)
Raaaah quelle poisse
Amélioration du code :
Option Explicit
Sub Maj()
Dim i%, URL$, txt$, obj As New DataObject
Const site = "https://www.google.fr/maps/place/"
Const debut = "https://maps.google.com/maps/api/staticmap?sensor=false¢er="
Const fin = "&zoom"
On Error Resume Next
For i = 2 To [A1].End(xlDown).Row
DoEvents
URL = site & Replace(Cells(i, 1).Value, " ", "+")
On Error Resume Next
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
If .Status = 200 Then
txt = Split(Split(.responseText, debut)(1), fin)(0)
Cells(i, 2) = Split(txt, "%")(0)
Cells(i, 3) = Mid(Split(txt, "%")(1), 3, 99)
Cells(i, 4) = "https://www.google.com/maps?f=q&hl=fr&q=" & Split(txt, "%")(0) & "," & Mid(Split(txt, "%")(1), 3, 99)
Cells(i, 5) = "Cliquer ici ..."
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 5), Address:=Cells(i, 4)
End If
End With
Next
End SubJai oublié de préciser qu'il faut activer la reference aux expressions regulieres
Mieux écrit + correction = j'ai pris les coordonnées du marker et non le centre de la carte donné par google
Option Explicit
Sub Maj()
Dim i%, URL$, LatLon$
Const site = "https://www.google.fr/maps/place/"
Const debut = "&markers="
Const fin = "&"
Const sep = "%2C"
Const lien = "https://www.google.com/maps?f=q&hl=fr&q="
On Error Resume Next
For i = 2 To [A1].End(xlDown).Row
DoEvents
URL = site & Replace(Cells(i, 1).Value, " ", "+")
On Error Resume Next
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
If .Status = 200 Then
LatLon = Split(Split(.responseText, debut)(1), fin)(0)
Cells(i, 2) = Split(LatLon, sep)(0)
Cells(i, 3) = Split(LatLon, sep)(1)
Cells(i, 4) = lien & LatLon
Cells(i, 5) = "Cliquer ici ..."
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 5), Address:=Cells(i, 4)
End If
End With
Next
End Sub