Microsoft 365 Trouver coordonnées a partir d'un nom de ville OpenStreetMap

burger0715 · 24 Juin 2022

Bonjour !

Je voudrais solliciter votre aide, je souhaite trouver automatiquement les coordonnées d'une ville juste en ayant son nom grâce à OpenStreetMap (je peux pas utiliser d'API). J'ai trouvé un tuto pour le faire mais le problème c'est qu'il utilise InternetExplorer, or je ne sais pas si c'est parce qu'IE à fermé le 15 juin dernier, mais OPS(OpenStreetMap) ne marche plus dessus. J'aimerais donc utiliser GoogleChrome à la place mais c'est vraiment plus compliqué à priori et je n'arrive pas à adapter le code.

Si quelqu'un à une idée de comment faire ça m'aiderait beaucoup, merci d'avance !

NB : Voici le vba

VB:

Function coordonneesGPS(URL As String)
Dim web As Object
Set web = CreateObject("InternetExplorer.Application")
web.navigate URL
Do While web.busy And web.readyState <> 4
    DoEvents
Loop
pause (1)
coordonnesGPS = web.locationUrl
web.Quit

End Function
    Sub pause(duree As Double)
    Dim finPause As Double
    finPause = Timer + duree
    Do While Timer < finPause
        DoEvents
    Loop
End Sub

fanch55 · 29 Juin 2022

Petit bug trouvé .
Version conseillée ci-jointe

vincent-laurent · 16 Janvier 2023

fanch55 à dit:
Re,
Classeur modifié pour utiliser Ops.
Obligé d'utiliser WinHttpRequest,
le premier appel au Get est lent : entre 10 et 26 secondes ..
les appels suivant durent moins de la seconde ...

bonjour, je voudrais utiliser votre module mais j'utilise libre office sous mac lorsque je rentre dans le tableau une nouvelle adresse on me dit erreur #valeur! et quand je regarde dans le script il me dit erreur de syntax basic symbole inattendu : object et il me surligne Name à la ligne 13
Je n'y connais pas grand chose et je me pose la question comment fait il appel à OPS je ne vois aucun lien vers ce site
Merci de votre réponse

fanch55 · 16 Janvier 2023

vincent-laurent à dit:
je me pose la question comment fait il appel à OPS je ne vois aucun lien vers ce site
Merci de votre réponse

Bonjour,
Ops a été employé à tort, c'est plutôt OSM = OpenStreetMap

Enrichi (BBcode):

Option Explicit
'
' Fanch55 Juin 2022
'
Sub Start_Gps()
Dim Stamp   As Variant
Dim UrlReq  As Variant
Dim Line    As Range
Dim R       As Long
  
    [TabGps[[Longitude]:[Name]]].ClearContents
    Stamp = Timer
    Application.ScreenUpdating = False
        For Each Line In [TabGps].Rows
            R = Line.Row - [TabGps[#Headers]].Row
          ' On décompose les assignations pour plus de clarté
          ' car le Vbe est mauvais avec les continuations avec des crochets
          ' Cela permet également de mettre une des assignations en commentaire sans la supprimer ..
            UrlReq = vbNullString
            UrlReq = UrlReq & [TabGps[Id]].Rows(R) & " "
            UrlReq = UrlReq & [TabGps[Adresse]].Rows(R) & " "
            UrlReq = UrlReq & [TabGps[Cp]].Rows(R) & " "
            UrlReq = UrlReq & [TabGps[Ville]].Rows(R) & " "
            UrlReq = UrlReq & [TabGps[Pays]].Rows(R)
          
            [TabGps[[Longitude]:[Name]]].Rows(R) = GetGps([Site], UrlReq)
            [TabGps[Requête]].Rows(R) = UrlReq
          
        Next
        [TabGps].Calculate
    Application.ScreenUpdating = True
    MsgBox "Temps d'exécution : " & Timer - Stamp & " secondes."

End Sub
Function GetGps(Url, Adr) ' renvoie un tableau de 3 éléments:  latitude,longitude et Nom de l'endroit
Dim XmlHttpRequest  As Object
Dim Reponse         As Object
    GetGps = Array("", "", "Stop: Pas d'adresse indiquée")

    Adr = WorksheetFunction.EncodeURL(Trim(Adr))
    If Adr <> vbNullString Then
      
'        Set XmlHttpRequest = CreateObject("MSXML2.serverXMLHTTP")
        Set XmlHttpRequest = CreateObject("MSXML2.XMLHTTP")
        With XmlHttpRequest
            .Open "GET", Url & "/search?limit=1&format=xml&q=" & Adr, False
            .Send
            If .Status <> 200 Then
                GetGps = Array("", "", "Stop: " & .ResponseXML.Text)
                Err.Clear
             Else
                Set Reponse = .ResponseXML.SelectSingleNode("//place")
                If Not Reponse Is Nothing Then
                    With Reponse.Attributes
                     GetGps = Array(Format(.getnameditem("lat").Value, "0.00000"), _
                                    Format(.getnameditem("lon").Value, "0.00000"), _
                                           .getnameditem("display_name").Value)
                    End With
                    Set Reponse = Nothing
                Else
                    GetGps = Array("", "", "Stop: Pas de coordonnées pour l'adresse indiquée")
                End If
             End If
        End With
        Set XmlHttpRequest = Nothing
    End If

End Function

vincent-laurent · 16 Janvier 2023

fanch55 à dit:

Bonjour,
Ops a été employé à tort, c'est plutôt OSM = OpenStreetMap
Regarde la pièce jointe 1160496

Enrichi (BBcode):

Option Explicit
'
' Fanch55 Juin 2022
'
Sub Start_Gps()
Dim Stamp   As Variant
Dim UrlReq  As Variant
Dim Line    As Range
Dim R       As Long
 
    [TabGps[[Longitude]:[Name]]].ClearContents
    Stamp = Timer
    Application.ScreenUpdating = False
        For Each Line In [TabGps].Rows
            R = Line.Row - [TabGps[#Headers]].Row
          ' On décompose les assignations pour plus de clarté
          ' car le Vbe est mauvais avec les continuations avec des crochets
          ' Cela permet également de mettre une des assignations en commentaire sans la supprimer ..
            UrlReq = vbNullString
            UrlReq = UrlReq & [TabGps[Id]].Rows(R) & " "
            UrlReq = UrlReq & [TabGps[Adresse]].Rows(R) & " "
            UrlReq = UrlReq & [TabGps[Cp]].Rows(R) & " "
            UrlReq = UrlReq & [TabGps[Ville]].Rows(R) & " "
            UrlReq = UrlReq & [TabGps[Pays]].Rows(R)
         
            [TabGps[[Longitude]:[Name]]].Rows(R) = GetGps([Site], UrlReq)
            [TabGps[Requête]].Rows(R) = UrlReq
         
        Next
        [TabGps].Calculate
    Application.ScreenUpdating = True
    MsgBox "Temps d'exécution : " & Timer - Stamp & " secondes."

End Sub
Function GetGps(Url, Adr) ' renvoie un tableau de 3 éléments:  latitude,longitude et Nom de l'endroit
Dim XmlHttpRequest  As Object
Dim Reponse         As Object
    GetGps = Array("", "", "Stop: Pas d'adresse indiquée")

    Adr = WorksheetFunction.EncodeURL(Trim(Adr))
    If Adr <> vbNullString Then
     
'        Set XmlHttpRequest = CreateObject("MSXML2.serverXMLHTTP")
        Set XmlHttpRequest = CreateObject("MSXML2.XMLHTTP")
        With XmlHttpRequest
            .Open "GET", Url & "/search?limit=1&format=xml&q=" & Adr, False
            .Send
            If .Status <> 200 Then
                GetGps = Array("", "", "Stop: " & .ResponseXML.Text)
                Err.Clear
             Else
                Set Reponse = .ResponseXML.SelectSingleNode("//place")
                If Not Reponse Is Nothing Then
                    With Reponse.Attributes
                     GetGps = Array(Format(.getnameditem("lat").Value, "0.00000"), _
                                    Format(.getnameditem("lon").Value, "0.00000"), _
                                           .getnameditem("display_name").Value)
                    End With
                    Set Reponse = Nothing
                Else
                    GetGps = Array("", "", "Stop: Pas de coordonnées pour l'adresse indiquée")
                End If
             End If
        End With
        Set XmlHttpRequest = Nothing
    End If

End Function

ok merci mais cela ne me dit pas comment le faire marcher , j'ai ouvert libre office et j'ai bien la macro et les 2 feuilles j'ai saisi manuellement 2 nouvelles adresses et j'ai fait un copier coller des formules long et lat dans mes nouvelles lignes les cases restent vides comment lancer l'appli , je suis désolé mais je suis super novice sur ce genre de chose je ne suis qu'un utilisateur et je veux simplement récuperer les points GPS de mes clients pour afficher sur une carte merci bien

fanch55 · 16 Janvier 2023

Exemple d'emploi

gbinforme · 16 Janvier 2023

Bonsoir,
je crains que le classeur "exemple d'emploi" ne soit pas arrivé à la bonne destination.

fanch55 · 17 Janvier 2023

gbinforme à dit:
Bonsoir,
je crains que le classeur "exemple d'emploi" ne soit pas arrivé à la bonne destination.

Le lien en cliquant sur "exemple emploi" n'est pas un classeur
mais un fichier .Gif plus volumineux qua la taille autorisée par le forum .
Il est sur Google Drive, et je n'avais pas donné les bonnes autorisations de lecture, ce qui a été corrigé ce lundi.

vincent-laurent · 17 Janvier 2023

fanch55 à dit:
Le lien en cliquant sur "exemple emploi" n'est pas un classeur
mais un fichier .Gif plus volumineux qua la taille autorisée par le forum .
Il est sur Google Drive, et je n'avais pas donné les bonnes autorisations de lecture, ce qui a été corrigé ce lundi.

Ok merci beaucoup ca j'avais bien compris mais j'avais des pb de java non installé sur mon mac mais j'ai toujours maintenant des soucis d'assignation du bouton récupérer les infos mais pas grave je viens de trouver une routine sous libre office et OSM plus simple et qui marche bien que je vais adapter mais ca me suffit amplement pour récupérer les infos en csv en tout cas merci beaucoup pour votre temps

Microsoft 365 Trouver coordonnées a partir d'un nom de ville OpenStreetMap

burger0715

XLDnaute Nouveau

Pièces jointes

fanch55

vincent-laurent

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

vincent-laurent

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

gbinforme

XLDnaute Impliqué

fanch55

XLDnaute Barbatruc

vincent-laurent

XLDnaute Nouveau

Pièces jointes

Discussions similaires