a oui!! joli aussi en xml
ca me correspond mieux je suis plus a l' aise avec cet object
mais ca change rien
Google a un strabisme phénoménal!!!
a oui!! joli aussi en xml
ca me correspond mieux je suis plus a l' aise avec cet object
mais ca change rien
Google a un strabisme phénoménal!!!
Hum hum, bizarre ce fonctionnement en effet !
re
tu a vu la version xml de vwtroudy c'est pas mal du tout
je l'ai reprise en late binding pour la transportabilité
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19 Sub test_en_XML() MsgBox getAddress("43.120337,5.969046") End Sub Function getAddress(points) Dim strAddress As String 'define XML and HTTP components Dim googleResult As Object, googleService As Object 'Dim oNodes As MSXML2.IXMLDOMNodeList 'Dim oNode As MSXML2.IXMLDOMNode Set googleService = CreateObject("MSXML2.XMLHTTP") Set googleResult = CreateObject("MSXML2.DOMDocument") googleService.Open "GET", "http://maps.googleapis.com/maps/api/geocode/xml?latlng=" & points, False googleService.setRequestHeader "DNT", "1" On Error Resume Next googleService.send googleResult.LoadXML (googleService.responseText) getAddress = googleResult.getElementsByTagName("formatted_address").Item(0).Text End Function
Pas de souci avec l'API :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23 Sub Demo() Const D = """formatted_address"" : """ Dim oReq As Object, P%, R&, SP$(), VA Set oReq = CreateObject("MSXML2.XMLHttp") VA = Me.UsedRange.Columns("A:B").Value ReDim VT$(1 To UBound(VA), 3 To 6) On Error Resume Next For R = 1 To UBound(VA) oReq.Open "GET", "http://maps.googleapis.com/maps/api/geocode/json?latlng=" & VA(R, 1) & "," & VA(R, 2), False oReq.setRequestHeader "DNT", "1" oReq.send If oReq.Status = 200 Then SP = Split(Split(Split(oReq.responseText, D)(1), """")(0), ", ") VT(R, 3) = SP(0) P = InStr(SP(1), " ") VT(R, 4) = Left$(SP(1), P - 1) VT(R, 5) = Mid$(SP(1), P + 1) VT(R, 6) = SP(2) End If Next Set oReq = Nothing [C1:F1].Resize(R - 1).Value = VT End Sub_________________________________________________________________________________________________________
Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …
voila maintenant on a les deux
lieu to points gps:
sans true dans lappel on a pas l'adresse complete format postal c'est optional
point to lieu:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Option Explicit 'MODEL D URL : http://maps.googleapis.com/maps/api/geocode/xml?address=" & lieu & " &sensor=false Sub test_en_XML() 'ON OBTIENT LES POINT GPS AVEC L'ADRESSE MsgBox getpoint_GPS_By_XML("chemin de forgentier toulon ", True) End Sub Function getpoint_GPS_By_XML(LIEU, Optional complet As Boolean = False) Dim latitude As String, longitude As String, additems As Object, adresse As String 'define XML and HTTP components If Not IsNumeric(Left(LIEU, 1)) Then LIEU = "0 " & LIEU ' pour pouvoir formaté l'adresse complete il me faut 6 item (long name) dans le document xml Dim googleResult As Object, googleService As Object, i As Integer 'Dim oNodes As MSXML2.IXMLDOMNodeList,oNode As MSXML2.IXMLDOMNode Set googleService = CreateObject("MSXML2.XMLHTTP") Set googleResult = CreateObject("MSXML2.DOMDocument") googleService.Open "GET", "http://maps.googleapis.com/maps/api/geocode/xml?address=" & LIEU &"&sensor=true", False googleService.setRequestHeader "DNT", "1" On Error Resume Next googleService.send Debug.Print googleService.responseText googleResult.LoadXML (googleService.responseText) latitude = googleResult.getElementsByTagName("lat")(0).Text longitude = googleResult.getElementsByTagName("lng")(0).Text getpoint_GPS_By_XML = latitude & "," & longitude 'OPTIONEL (PEUT ETRE SUPPRIME) If complet = True Then Set additems = googleResult.getElementsByTagName("long_name") If Val(additems(0).Text) > 0 Then adresse = additems(0).Text & " " adresse = adresse & " " & additems(1).Text & vbCrLf adresse = adresse & " " & additems(additems.Length - 1).Text & " " & additems(2).Text & vbCrLf adresse = adresse & " " & additems(3).Text & " / " & additems(4).Text & vbCrLf adresse = adresse & additems(5).Text getpoint_GPS_By_XML = getpoint_GPS_By_XML & vbCrLf & adresse End If End Function
voila bien plus pratique en XML
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21 Option Explicit Sub test_en_XML() 'ON OBTIENT L'ADRESSE AVEC LES POINT GPS MsgBox getAddress_By_point_gps_XML("43.120337,5.969046") End Sub Function getAddress_By_point_gps_XML(points) Dim strAddress As String 'define XML and HTTP components Dim googleResult As Object, googleService As Object 'Dim oNodes As MSXML2.IXMLDOMNodeList,oNode As MSXML2.IXMLDOMNode Set googleService = CreateObject("MSXML2.XMLHTTP") Set googleResult = CreateObject("MSXML2.DOMDocument") googleService.Open "GET", "http://maps.googleapis.com/maps/api/geocode/xml?latlng=" & points & "&sensor=true", False googleService.setRequestHeader "DNT", "1" On Error Resume Next googleService.send googleResult.LoadXML (googleService.responseText) getAddress_By_point_gps_XML = googleResult.getElementsByTagName("formatted_address").Item(0).Text End Function
Marc ton exemple en post 24 ne fonctionne pas chez moi il transforme le point en virgule dans l'url
Évidemment de mon côté je n'ai pas de souci car comme tu aurais pu le voir dans l'animation
les colonnes sont au format texte vu les points affichés …
moi aussi la plage est au format texte
Aucun souci sur des configurations différentes côté Windows (Seven / 8.1) comme Excel (2003 / 2010) :
qu'as-tu modifié alors dans mon code pour que du texte avec un point soit transformé en virgule ?!
re
j'ai juste mis "sheets(2)" a la place de "Me" car c'est dans un module standard
j'ai ajouté un debug et on vois bien que le point est remplacé par une virgule dans les point regarde bien le debug
et mes cellules sont bien au format texte
De mon côté (et testé sur différents Windows et différentes versions d'Excel) :
Et là c'est même avec des cellules au format Standard ‼
RE bonjour Marc
ben un truc qui marche chez tout le mondeWHAT ELSE???
je vais vérifier le seul truc qui est différent de toi a savoir module standard ou feuille juste pour voir si c'est cela bien que je ne pense pas
bon meme dans la feuille rien ne change
je fait un replace sur va(0) et va(1) et ca fonctionne
faudra quand meme m'expliquer pourquoi? hein!!!!!
sincèrement en XML c'est beaucoup plus simple
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23 Sub Demo() Const D = """formatted_address"" : """ Dim oReq As Object, P%, R&, SP$(), VA Set oReq = CreateObject("MSXML2.XMLHttp") VA = Sheets(2).UsedRange.Columns("A:B").Value ReDim VT$(1 To UBound(VA), 3 To 6) On Error Resume Next For R = 1 To UBound(VA) oReq.Open "GET", "http://maps.googleapis.com/maps/api/geocode/json?latlng=" & Replace(VA(R, 1), ",", ".") & "," & Replace(VA(R, 2), ",", "."), False oReq.setRequestHeader "DNT", "1" oReq.send If oReq.Status = 200 Then SP = Split(Split(Split(oReq.responseText, D)(1), """")(0), ", ") VT(R, 3) = SP(0) P = InStr(SP(1), " ") VT(R, 4) = Left$(SP(1), P - 1) VT(R, 5) = Mid$(SP(1), P + 1) VT(R, 6) = SP(2) End If Next Set oReq = Nothing [C1:F1].Resize(R - 1).Value = VT End Sub
oReq.Open "GET", http://maps.googleapis.com/maps/api/geocode/xml?latlng=............
Finalement on a réussi à obtenir quelques chose de bien sympatrique...
@+
bonjour vwtroudy
oui et en plus sous diverse forme
ne pas oublier d'ajouter a la fin de l'url "&sensor=true" pour la précision sinon c'est la plus proche
j'hésite encore la quelle solution je vais garder pour ma contrib
Bonjour à tous,
Patrick, je suppose que ton séparateur système est la ",".bon meme dans la feuille rien ne change
je fait un replace sur va(0) et va(1) et ca fonctionne
faudra quand meme m'expliquer pourquoi? hein!!!!!
Décocher 'Utiliser les séparateurs système' pour essayer avec le séparateur excel mis à "." ne suffit pas.
VBA se sert toujours du séparateur système qq soit l'état de la coche. Si tu y laisses la "," tu es obligé d'utiliser Replace()
eric
Bonjour eriic
oui jesuppose que ca dioit etre un truc du genre
je n'ai jamais modifier quoi que se soit dans office alors il est d'origine
je vais vérifier dnas les paramètres
apres du coup je suis en train de revoir completement ma contrib sur les trajet avec detail et j'utilise la requete en XML aussi
c'est largement plus facile a trouver les elements
une ebauche
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Sub test() MsgBox itigoogle("34 bd de la roseraie toulon", "paris 75000") End Sub function itigoogle(dep, fin) Dim REQ As Object, url As String Set REQ = CreateObject("microsoft.xmlhttp") Set googleResult = CreateObject("MSXML2.DOMDocument") url = "http://maps.google.fr/maps/api/directions/xml?origin=" & Replace(dep, " ", "") & ",&destination=" & Replace(fin, " ", "") With REQ .Open "POST", url, False .setRequestHeader "Accept", "text/html, application/xhtml+xml, */*" .setRequestHeader "Accept-Language", "fr-FR" .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko" .setRequestHeader "Accept-Encoding", "gzip, deflate" .setRequestHeader "Host", "maps.google.fr" .setRequestHeader "Connection", "Keep - Alive" .setRequestHeader "Cache-Control", "no-cache" .send googleResult.LoadXML (REQ.responsetext) Set etape = googleResult.getElementsByTagName("html_instructions") Set distance = googleResult.getElementsByTagName("distance") Set duré = googleResult.getElementsByTagName("duration") For i = 0 To etape.Length - 1 itigoogle = itigoogle & "*********************************" & vbCrLf itigoogle = itigoogle & Replace(Replace(etape(i).Text, "<b>", ""), "</b>", "") & ":" itigoogle = itigoogle & distance(i).ChildNodes(1).Text & " pendant " itigoogle = itigoogle & duré(i).ChildNodes(1).Text & vbCrLf Next 'itigoogle = .responsetext End With End Function
Je sais pas trop ou vous en êtes dans cette discussion mais juste comme ça (ça fait déjà quelque mois que je l'utilise sans problème ) :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Public Function URLEncode(StringToEncode As String, Optional _ UsePlusRatherThanHexForSpace As Boolean = False) As String Dim TempAns As String Dim CurChr As Integer CurChr = 1 Do Until CurChr - 1 = Len(StringToEncode) Select Case asc(Mid(StringToEncode, CurChr, 1)) Case 48 To 57, 65 To 90, 97 To 122 TempAns = TempAns & Mid(StringToEncode, CurChr, 1) Case 32 If UsePlusRatherThanHexForSpace = True Then TempAns = TempAns & "+" Else TempAns = TempAns & "%" & Hex(32) End If Case Else TempAns = TempAns & "%" & _ Format(Hex(asc(Mid(StringToEncode, _ CurChr, 1))), "00") End Select CurChr = CurChr + 1 Loop URLEncode = TempAns End Function
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Function ReverseGeocode(lat As String, lng As String) As String Dim strAddress As String Dim strLat As String Dim strLng As String Dim strQuery As String Dim strLatitude As String Dim strLongitude As String strLat = URLEncode(lat) strLng = URLEncode(lng) 'Assemble the query string strQuery = gstrGeocodingURL strQuery = strQuery & "latlng=" & strLat & "," & strLng If gblnBusiness = 0 Then strQuery = strQuery & "&sensor=false" End If 'define XML and HTTP components Dim googleResult As New MSXML2.DOMDocument Dim googleService As New MSXML2.XMLHTTP Dim oNodes As MSXML2.IXMLDOMNodeList Dim oNode As MSXML2.IXMLDOMNode 'create HTTP request to query URL - make sure to have googleService.Open "GET", gstrGeocodingDomain & strQuery, False googleService.send googleResult.LoadXML (googleService.responseText) Set oNodes = googleResult.getElementsByTagName("formatted_address") If oNodes.Length > 0 Then ReverseGeocode = oNodes.Item(0).Text Else ReverseGeocode = "Not Found" End If End Function
oulah!! al_22 tout les chemins mènent a Rome comme on dit mais le tiens il est long ...il est long....
une simple requête avec le l'object xmlhttp récupération du code source (en Xml) et voila tu récupère l'élément que tu veut dans un xml en mémoire
encore un exemple juste dans mon post précédant
je ne vois pas plus facile
encoder l'url pourquoi?? la requête la prend comme tel
ma fois pour moi c'est vraiment pédaler beaucoup
Je sais pas si il est long mais il marche bien
Pour ce qui est de l'encodage c'est juste que j'avais remarqué que sans la plus part du temps ça ne marchait pas car le service geocoding ne comprenait pas toujours le format lettre d'Excel (pourquoi ? aucune idée )
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager