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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
Option Compare Database
Option Explicit
'Type public contenant le géocodage de l'adresse postale
Public Type tAdresseGeo
dLatitude As Double
dLongitude As Double
sRetAdresse As String
sExactitude As String
sStatut As String
End Type
'fonction de test
Public Function test()
Dim tGeo As tAdresseGeo
'appel du géocodage de l'adresse postale
tGeo = PostalToGeoViaGM("place bellecour", "69002", "lyon")
MsgBox "Code retour" & vbTab & ": " & tGeo.sStatut & vbCrLf & vbCrLf & _
"Latitude" & vbTab & vbTab & ": " & tGeo.dLatitude & vbCrLf & _
"Longitude" & vbTab & ": " & tGeo.dLongitude & vbCrLf & _
"Exactitude" & vbTab & ": " & tGeo.sExactitude & vbCrLf & vbCrLf & _
"Adresse postale" & vbTab & ": " & vbCrLf & "-> " & tGeo.sRetAdresse
End Function
'---------------------------------------------------------------------------------------
' Procedure : PostalToGeoViaGM via Google Geocoding API v3
' Version : 1.0
' DateTime : 10/10/2010 10:10
' Author : Philippe
' Purpose : Géocodage d'une adresse postale via google map
' : Renseigner le maximum de paramètres pour obtenir un meilleur géocodage
' : Vérifier le géocodage car on a parfois de mauvaises surprises...
' Paramètre : Aucun paramètre obligatoire mais tous au format texte ou NULL
' Retour : Une structure tAdresseGeo contenant la latitude, la longitude,
' l'adresse postale renvoyée par Google, l'exactitude du géocodage,
' et le statut du géocodage.
' Infos : Statut retourné par Google :
' - "OK" : Pas d'erreur
' - "ZERO_RESULTS" : Géocodage ok mais pas de résultat
' - "OVER_QUERY_LIMIT" : Quota dépassé des demandes de géocodage
' - "REQUEST_DENIED" : Demande refusée
' - "INVALID_REQUEST" : Requête non valide
' : Exactitude du géocodage :
' - "ROOFTOP" : Excellente, précision au n° de rue ?
' - "RANGE_INTERPOLATED": Bonne précision, supérieure à la rue ?
' - "GEOMETRIC_CENTER" : Correcte, précision à la rue
' - "APPROXIMATE" : Approximation du résultat...
' Référence : http://code.google.com/intl/fr-FR/apis/maps/documentation/geocoding/index.html
'---------------------------------------------------------------------------------------
Public Function PostalToGeoViaGM(Optional ByVal vAdresse As Variant = Null, _
Optional ByVal vCP As Variant = Null, _
Optional ByVal vCommune As Variant = Null, _
Optional ByVal vDepartement As Variant = Null, _
Optional ByVal sPays As Variant = "France") As tAdresseGeo
On Error GoTo errtag
Dim oXmlDoc As Object
Dim sUrl As String, sFormatAdresse As String
If Not IsNull(vAdresse) Then vAdresse = Replace(vAdresse, ",", " ")
'Formatage de l'adresse
sFormatAdresse = (vAdresse + ",") & _
(vCP + ",") & _
(vCommune + ",") & _
(vDepartement + ",") & _
sPays
'Création de l'URL d'appel, renvoi d'un xml contenant les informations
sUrl = "http://maps.googleapis.com/maps/api/geocode/xml?address=" & sFormatAdresse & "&sensor=false"
'Créér l'objet xml
Set oXmlDoc = CreateObject("Microsoft.XMLDOM")
With oXmlDoc
.Async = False
If .Load(sUrl) And Not .selectSingleNode("GeocodeResponse//status") Is Nothing Then
'Code retour de l'appel
PostalToGeoViaGM.sStatut = .selectSingleNode("GeocodeResponse//status").Text
'S'il existe un résultat du géocodage
If Not .selectSingleNode("GeocodeResponse//result") Is Nothing Then
'Adresse postale géocodée : Permet de vérifier éventuellement une erreur de géocodage
PostalToGeoViaGM.sRetAdresse = .selectSingleNode("//formatted_address").Text
'Niveau d'exactitude du géocodage
PostalToGeoViaGM.sExactitude = .selectSingleNode("//location_type").Text
'Latitude et longitude
PostalToGeoViaGM.dLatitude = Val(.selectSingleNode("//location//lat").Text)
PostalToGeoViaGM.dLongitude = Val(.selectSingleNode("//location//lng").Text)
End If
End If
End With
fin:
Set oXmlDoc = Nothing
Exit Function
errtag:
MsgBox "Erreur n°:" & Err & vbCrLf & "Description:" & Err.Description, vbExclamation, "PostalToGeoViaGM"
Resume fin
End Function |
Géocoder des adresses postales
Répondre avec citation
le besoin de quelques jours de repos commence à se faire sentir...
.
Partager