XL 2021 Récupérer la latitude et longitude de sa position actuelle

[Nicolas JACQUIN]

Bonjour à tous,

Je cherche à récupérer automatiquement ma position, longitude,latitude et ville, à l'ouverture du classeur,
pour les placer en variable et les intégrer dans mon programme

J'ai essayé avec "https://www.google.fr/maps/place/" mais je connais pas
J'ai trouvé des choses en rentrant la ville mais c'est pas ça que je souhaite

Merci d'avance à tous

Nicolas

 

[jurassic pork]

sinon pour récupérer les coordonnées GPS à partir d'une adresse postale cela n'est pas bien compliqué en utilisant le site du gouvernement api-adresse.data.gouv.fr

Function Gps(Adr As String) As Variant
    Const GOUV = "https://api-adresse.data.gouv.fr/search/?q="
    Dim Txt As String, t As Variant
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", GOUV & Adr & "&limit=1", False
        .send
    Txt = .responseText
    End With
    t = Split(Txt, "coordinates"":[")
    Gps = Split(t(1), "]}")(0)
End Function
Sub TestLocGPS()
  Debug.Print Gps("Tour Eiffel Paris")
End Sub

Avec ce code j'obtiens :

2.294844,48.857739

 

[vgendron]

sinon pour récupérer les coordonnées GPS à partir d'une adresse postale cela n'est pas bien compliqué en utilisant le site du gouvernement api-adresse.data.gouv.fr

Function Gps(Adr As String) As Variant
    Const GOUV = "https://api-adresse.data.gouv.fr/search/?q="
    Dim Txt As String, t As Variant
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", GOUV & Adr & "&limit=1", False
        .send
    Txt = .responseText
    End With
    'Txt = HTML(GOUV & Adr & "&limit=1").Txt
    t = Split(Txt, "coordinates"":[")
    Gps = Split(t(1), "]}")(0)
End Function
Sub TestLocGPS()
  Debug.Print Gps("Tour Eiffel Paris")
End Sub

Avec ce code j'obtiens :

= post #57

 

[Staple1600]

Bonjour le fil

[Pour info]
@dysorthographie
Sur W10, ie est ici
iePath = "C:\Program Files (x86)\Internet Explorer\iexplore.exe"

Sinon, Microsoft affiche un message pour m'inciter à utiliser Edge

Au final, test presque OK, car c'est Google qui bronche en me disant
Impossible de trouver xx,xx, -x,xxxx dans Google Maps

NB: x= certains chiffres

Mais la carte qui s'affiche est dans mon coin

EDITION: En testant manuellement dans Maps, les données ont 7 chiffres aprés la décimale
et le séparateur est le point pas la virgule

[/Pour info]

 

[dysorthographie]

pour utiliser le navigateur par défaut

Type PositionGps
    latitude As String
    longitude As String
    Ville As String
End Type
Sub test()
Dim Pos As PositionGps
Pos = GPS
openUrl "https://www.google.com/maps?q=" & latitude & "," & longitude
End Sub
Private Function GPS() As PositionGps
    Dim Position As Object
    
    ' Obtenir la position de l'utilisateur
    Set Position = GetCurrentPosition()
    
    ' Extraire les informations de position
    GPS.latitude = Position("lat")
    GPS.longitude = Position("lon")
    GPS.Ville = Position("city")
    
  
End Function
Sub openUrl(URL As String)
    ' Ouvre l'URL dans le navigateur par défaut
    Shell "cmd.exe /c start " & URL, vbHide
End Sub


Function GetCurrentPosition() As Object
    Dim http As Object
    Dim jsonResponse As Object
    Dim URL As String
    
    URL = "http://ip-api.com/json/"
    
    ' Créer une instance de l'objet XMLHttpRequest
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    ' Effectuer la requête GET
    On Error GoTo ErrorHandler
    http.Open "GET", URL, False
    http.Send
    
    ' Analyser la réponse JSON
    Set jsonResponse = JsonConverter.ParseJson(http.responseText)
    
    ' Nettoyer
    Set http = Nothing
    
    ' Retourner la réponse JSON
    Set GetCurrentPosition = jsonResponse
    Exit Function

ErrorHandler:
    ' Gestion des erreurs
    MsgBox "Erreur lors de la récupération des données : " & Err.Description
    Set GetCurrentPosition = Nothing
    Set http = Nothing
End Function

 

[jurassic pork]

= post #57

Désolé mais je ne regarde pas les vidéos et je n'ouvre pas tous les documents c'est pour cela que moi en général je mets le code dans la discussion

 

[Staple1600]

Re

@dysorthographie
Tu as vu le message#78?

Même en faisant ceci

Private Function GPS() As PositionGps
    Dim Position As Object
    ' Obtenir la position de l'utilisateur
    Set Position = GetCurrentPosition()
    ' Extraire les informations de position
    GPS.latitude = Replace(Position("lat"), ",", ".")
    GPS.longitude = Replace(Position("lon"), ",", ".")
    GPS.Ville = Position("city")
End Function

J'arrive dans la bonne ville mais pas à la bonne adresse
(mais plus de message d'erreur dans Maps)

 

[vgendron]

une petite correction à apporter à la sub test de dyso

Sub test()
Dim Pos As PositionGps
Pos = GPS
openUrl "https://www.google.com/maps?q=" & pos.latitude & "," & pos.longitude
End Sub

 

[Staple1600]

Bonjour @vgendron

Toujours la même erreur dans Maps (voir message#78)

 

[jurassic pork]

J'arrive dans la bonne ville mais pas à la bonne adresse

Hello,
tu as vu mon message #73 , si la localisation est basée sur l' I.P on obtient en fait les coordonnées de l'endroit où on est raccordé (en général le point de raccordement local de son FAI).

 

[Nicolas JACQUIN]

pour utiliser le navigateur par défaut

Type PositionGps
    latitude As String
    longitude As String
    Ville As String
End Type
Sub test()
Dim Pos As PositionGps
Pos = GPS
openUrl "https://www.google.com/maps?q=" & latitude & "," & longitude
End Sub
Private Function GPS() As PositionGps
    Dim Position As Object
   
    ' Obtenir la position de l'utilisateur
    Set Position = GetCurrentPosition()
   
    ' Extraire les informations de position
    GPS.latitude = Position("lat")
    GPS.longitude = Position("lon")
    GPS.Ville = Position("city")
   
 
End Function
Sub openUrl(URL As String)
    ' Ouvre l'URL dans le navigateur par défaut
    Shell "cmd.exe /c start " & URL, vbHide
End Sub


Function GetCurrentPosition() As Object
    Dim http As Object
    Dim jsonResponse As Object
    Dim URL As String
   
    URL = "http://ip-api.com/json/"
   
    ' Créer une instance de l'objet XMLHttpRequest
    Set http = CreateObject("MSXML2.XMLHTTP")
   
    ' Effectuer la requête GET
    On Error GoTo ErrorHandler
    http.Open "GET", URL, False
    http.Send
   
    ' Analyser la réponse JSON
    Set jsonResponse = JsonConverter.ParseJson(http.responseText)
   
    ' Nettoyer
    Set http = Nothing
   
    ' Retourner la réponse JSON
    Set GetCurrentPosition = jsonResponse
    Exit Function

ErrorHandler:
    ' Gestion des erreurs
    MsgBox "Erreur lors de la récupération des données : " & Err.Description
    Set GetCurrentPosition = Nothing
    Set http = Nothing
End Function

Merci Robert, pour moi ça match bien, à 500 mètres mais ça me convient
Merci

 

[Staple1600]

Re

@jurassic pork
Avec ton code, j'arrive à la bonne adresse
Faut juste que je bidouille un peu pour que Maps fasse le boulot

Sub TestLocGPS()
Dim strResult$, tmp, Localisation$
strResult = Gps("adresse postale")
tmp = Split(strResult, ",")
Localisation = tmp(1) & " , " & tmp(0)
Debug.Print Localisation
End Sub

PS: je parlais du problème de point vs virgule dans Maps
D'où mon utilisation de Replace

 

[Nicolas JACQUIN]

une petite correction à apporter à la sub test de dyso

Sub test()
Dim Pos As PositionGps
Pos = GPS
openUrl "https://www.google.com/maps?q=" & pos.latitude & "," & pos.longitude
End Sub

Je l'ai testé comme ça ça match

Sub test()
Dim Pos As PositionGps
Pos = GPS
Debug.Print GPS.latitude
Debug.Print GPS.longitude
Debug.Print GPS.Ville
openUrl "https://www.google.com/maps?q=" & latitude & "," & longitude

 

[Staple1600]

Re

[Aux participants du fil]
Je suis le seul à avoir cet "erreur" (*) dans Maps ?
(avec le code de @dysorthographie )

(*) : même si une carte s'affiche quand même dans Maps

(erreur supprimée avec l'emploi de Replace, cf message#81)

 

[Nicolas JACQUIN]

Une petite question, pourquoi j'arrive pas à récupérer la valeur dans le bon format

 

[Nicolas JACQUIN]