Fonction VBA pour récupérer l'URL d'une page web

Version imprimable

2 pièce(s) jointe(s)

Bonjour,

J'ai besoin de votre aide pour un souci :

mon objectif : je veux récupérer les coordonnées gps à l'aide d'une fonction vba avec en entrée une adresse quelconque, pour ça j'essaie accéder à l'URL de la page open street map, ouverte à partir d'une adresse donnée en paramètre, dans le but d'extraire les coordonnées gps de cette adresse qui sont contenues dans l'URL de la page

mon problème : j'ai trouvé un programme sur internet qui permet à peu près de faire ça, je l'ai un peu modifié , mais ça ne marche mais quand j'appelle ma fonction en étant dans une feuille excel.

le code : (la version modifiable est dans le fichier ci-joint)

Pièce jointe 619053
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Option Explicit Function AdresseToCoordonnesGPS(URL As String) 'URL contient la recherche qu'on veut faire par, par exemple : URL="https://www.openstreetmap.org/search?query="&A2 'où la cellule A2 contient l'adresse du lieu, 'voici la partie qui lance l'adresse dans le navigateur Dim navigateur As Object Set navigateur = CreateObject("Shell.Application").ShellExecute("microsoft-edge:" & URL) 'CreateObject("MicrosoftEdge.Application") navigateur.Visible = True Do While navigateur.busy And navigateur.ReadyState <> 4 DoEvents Loop pause (3) Dim redirection As String 'cette variable contiendra la partie intéressante du lien passé en argument càd les coordonnées gps N,E redirection = navigateur.locationUrl redirection = Right(redirection, Len(redirection) - InStr(redirection, "#")) 'les coordonnées gps se trouvent à droite du sigle # dans l'url redirection = Right(redirection, Len(redirection) - InStr(redirection, "/")) AdresseToCoordonnesGPS = redirection End Function
le retour :

ce code m'ouvre bien la page microsoft edge mais ne récupère pas l'adresse de la page, ce qui m'intéresse, j'ai le msg ""#VALEUR!" dans la cellule où j'ai entré la fonction AdresseToCoordonnesGPS
Pièce jointe 619055

MERCI de votre aide

13/05/2022, 11h01
jurassic pork

hello,
pourquoi n'utilises -tu pas l'objet internetexplorer.application ? Il n'y a pas d'objet équivalent pour msedge. Pour msedge il faut passer par seleniumbasic ou Chrome Devtools Protocole ( voir ici).
Ami calmant, J.P
13/05/2022, 11h13
hamza.arif

Citation:

Envoyé par jurassic pork

hello,
pourquoi n'utilises -tu pas l'objet internetexplorer.application ? Il n'y a pas d'objet équivalent pour msedge. Pour msedge il faut passer par seleniumbasic ou Chrome Devtools Protocole ( voir ici).
Ami calmant, J.P

Bonjour,

Merci pour ta réponse
Deux choses :

1) même avec l'objet internetexplorer.application, ça ne fonctionne pas (j'avais trouvé la fonction dans cette vidéo : https://www.youtube.com/watch?v=DcIrj0U_8HM)

2) internet explorer est obsolète, je veux que mon programme puisse fonctionner avec un navigateur d'actualité, comme microsoft edge

Il me semble que openstreetmap n'est pas le site le plus fiable pour récupérer ce que tu cherches. Le gouvernement français propose un site qui possède une api pour récupérer les coordonnées GPS d'après une adresse il s'agit de adresse.data.gouv.fr

Citation:

Le site national des adresses
Référencer l’intégralité des adresses du territoire et les rendre utilisables par tous.

Voici un exemple d'utilisation de l'api en VBA . La réponse de l'api est en json, j'utilise les expressions régulières pour récupérer la latitude et la longitude de la réponse.

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
Sub RecupCoordGPS(Adresse As String)
Dim Url, Reponse, latitude, longitude
Dim oRegExp As Object, oRegMatches As Object
Set oRegExp = CreateObject("vbscript.regexp")
oRegExp.Pattern = "coordinates.*\[([\d.]+),\s([\d.]+)\]"
Url = "https://api-adresse.data.gouv.fr/search/?q=" & Adresse
With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", Url, False
    .send
      If .readyState = 4 Then
        If .Status <> 200 Then
           MsgBox "Erreur HTTP : " & .Status
        Else
           Reponse = .responseText
           Debug.Print Reponse
           Set oRegMatches = oRegExp.Execute(Reponse)
           If oRegMatches.Count = 1 Then
               longitude = oRegMatches(0).SubMatches(0)
               latitude = oRegMatches(0).SubMatches(1)
           Debug.Print "Longitude : " & longitude
           Debug.Print "Latitude : " & latitude
           End If
        End If
      Else
           MsgBox "Erreur Etat : " & .readyState
      End If
  End With
Set oRegExp = Nothing
End Sub
 
 
Sub TestRecupCoordGPS()
  RecupCoordGPS Range("A2").Value
  RecupCoordGPS Range("A3").Value
End Sub

Voici ce que cela donne pour tes deux adresses :

Code:

1
2
3
4
5
6
{"type": "FeatureCollection", "version": "draft", "features": [{"type": "Feature", "geometry": {"type": "Point", "coordinates": [2.388629, 48.972176]}, "properties": {"label": "5 Rue Victor Hugo 95140 Garges-l\u00e8s-Gonesse", "score": 0.860274935064935, "housenumber": "5", "id": "95268_0700_00005", "name": "5 Rue Victor Hugo", "postcode": "95140", "citycode": "95268", "x": 655241.38, "y": 6874865.72, "city": "Garges-l\u00e8s-Gonesse", "context": "95, Val-d'Oise, \u00cele-de-France", "type": "housenumber", "importance": 0.67731, "street": "Rue Victor Hugo"}}], "attribution": "BAN", "licence": "ETALAB-2.0", "query": "5 rue Victor Hugo 95140  Garges-L\u00e8s-Gonnesse", "limit": 5}
Longitude : 2.388629
Latitude : 48.972176
{"type": "FeatureCollection", "version": "draft", "features": [{"type": "Feature", "geometry": {"type": "Point", "coordinates": [2.611006, 48.816735]}, "properties": {"label": "All\u00e9e de la Briarde 77184 \u00c9merainville", "score": 0.8044745454545453, "id": "77169_0073", "name": "All\u00e9e de la Briarde", "postcode": "77184", "citycode": "77169", "x": 671436.33, "y": 6857477.94, "city": "\u00c9merainville", "context": "77, Seine-et-Marne, \u00cele-de-France", "type": "street", "importance": 0.52422}}], "attribution": "BAN", "licence": "ETALAB-2.0", "query": "15 all\u00e9e de la Briarde  77184 Emerainville", "limit": 5}
Longitude : 2.611006
Latitude : 48.816735

Ami calmant, J.P

07/12/2022, 18h03
Web_Guys

Besoin d'aide s'il vous plaît

Bonsoir jurassic pork,

Merci pour votre partage, est-ce possible d'avoir un fichier Excel qui fonctionne avec votre code pour récuperer les coordonnées GPS, car je n'arrive pas à le faire fonctionner.

Ou un tuto pour le bon fonctionnement.

Se serai super en vous remerciant.

Bien cordialement.:roll:
25/01/2023, 17h57
bepii

un peu tard ?

Bonjour
pas mal jurassic pork
mais plante sur If oRegMatches.Count = 1, car sur mon essai = 0 ???
une solution peut-etre. merci
beppi