Como adicionar uma API do Google para retornar a distância ou tempo de uma rota definida. Com esta consulta é possível retornar a distância e o tempo médio da rota, baseado na mesma engine do Google Maps. O resultado pode ser retornado por Carro, caminhada, bicicleta (quando Disponível) ou transporte publico (quando disponível) O resultado Fica assim:  Agora, como montamos esse arquivo? Mãos a massa: 1. Precisamos retirar os acentos dos nomes, pois a API não reconhece acentos, para isso vamos criar uma Function que retira os acentos: Function Acento(caract) 'Acentos e caracteres especiais que serão buscados na string 'Você pode definir outros caracteres nessa variável, 'mas precisará também coloca-los sem acento! codiA = "àáâãäèéêëìíîïòóôõöùúûüÀÁÂÃÄÈÉÊËÌÍÎÒÓÔÕÖÙÚÛÜçÇñÑ" 'Letras correspondentes para substituiçãor a letra correspondente em codiB codiB = "aaaaaeeeeiiiiooooouuuuAAAAAEEEEIIIOOOOOUUUUcCnN" 'Armazena em temp a string recebida temp = caract 'Loop que irá de andará a string letra a letra For i = 1 To Len(temp) 'InStr buscará se a letra indice i de temp pertence a ' codiA e se existir retornará a posição dela p = InStr(codiA, Mid(temp, i, 1)) 'Substitui a letra de indice i em codiA pela sua ' correspondente em codiB If p > 0 Then Mid(temp, i, 1) = Mid(codiB, p, 1) Next 'Retorna a nova string Acento = tempEnd Function com essa function podemos chamar ela quando necessário na proxima function: 2. Vamos a API propriamente dita: Antes de começarmos, você deve adicionar a referência Microsoft XML, v6.0 Function DST(Resultado As String, Modo As String, Origem As String, Destino As String) As Variant ' Requer referencias Microsoft XML, v6.0 Dim MyReq As XMLHTTP60 Dim MyDoc As DOMDocument60 Dim MyDist As IXMLDOMNode Let DST = 0 'converte para texto especial Select Case UCase(Resultado) Case "KM" a = "distance/value" Case "H" a = "duration/text" Case "ORIGEM" a = "start_address" Case "DESTINO" a = "end_address" End Select Select Case UCase(Modo) Case "CARRO" b = "driving" Case "CAMINHADA" b = "walking" Case "BIKE" b = "bicycling" Case "PUBLICO" b = "transit" End Select On Error GoTo exitRoute Let Origem = Replace(Acento(Origem), " ", "%20") Let Destino = Replace(Acento(Destino), " ", "%20") ' Lendo os dados XML da API do Google Maps. Set MyReq = New XMLHTTP60 MyReq.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" _ & Origem & "&destination=" & Destino & "&sensor=false&mode=" & b, False MyReq.send ' Tornando o XML legível por usar o XPath Set MyDoc = New DOMDocument60 MyDoc.LoadXML MyReq.responseText ' Obtendo o valor da distância entre os nós. Set MyDist = MyDoc.SelectSingleNode("//leg/" & a) If UCase(Resultado) <> "KM" Then If Not MyDist Is Nothing Then DST = MyDist.Text Else If Not MyDist Is Nothing Then DST = MyDist.Text / 1000 End IfexitRoute: ' zerar strings Set MyDist = Nothing Set MyDoc = Nothing Set MyReq = Nothing End Functionpronto! sua API está criada! Lembre-se! Essa API permite somente 2500 consultas por dia!!! Adicionalmente você pode colocar as descrições nas formulas:  como? assim: Sub DescribeFunction()'adiciona texto a função Dim FuncName As String Dim FuncDesc As String Dim Category As String Dim ArgDesc(1 To 4) As String FuncName = "DST" FuncDesc = "Retorna dados de rotas via Google API" Category = 5 'Lookup ArgDesc(1) = "Tipo da rota" ArgDesc(2) = "Origem" ArgDesc(3) = "Destino" ArgDesc(4) = "Tipo de resultado" Application.MacroOptions _ Macro:=FuncName, _ Description:=FuncDesc, _ Category:=Category, _ ArgumentDescriptions:=ArgDesc End Sub |
Pagina Inicial > Excel >
