Excel içine google maps eklentisi

[kumralyakisikli]

Arkadaşlar forumda baya arama yaptım ama bu tarz bişey bulamadım ama işin açığı size soracağım konuyla alakalı zerre fikrim yok nasıl yapıldığına dair ve bunu benim için birinin uğraşıp yapmasını istemeye de hakkım yok ama yine de zamanı olan ve bunu nasıl yapacağıma dair bana yol gösterebilen birisi olursa çok sevinirim...
Sorum youtube sitesinde bir video gördüm linki aşağıda yapmak istediğim şey tam da bu....

https://www.youtube.com/watch?v=Nq4BeEcLG-c

 

[Emir Hüseyin Çoban]

. . .

Video sahibiyle iletişime geçtiniz mi.
Bence isterseniz dosyayı paylaşacaktır.

. . .

 

[kumralyakisikli]

Açıkçası iletişime geçmedim çünkü dosyayı paylaşacak olsa zaten video içine nasıl yapıldığına dair bir anlatım koyardı diye düşündüm ama yine de sormakta fayda var cevabın için teşekkür ederim... Yine de bu işi bilen arkadaşlarımdan en azından bir fikir önermeleri konusunda yardımlarınızı bekliyorum olası bir hayır cevabına karşı

 

[Zeki Gürsoy]

Videonun sağ alt kısmına dikkat edin; arka planda bir query table çalıştırmış. Ve bu table ın navigasyon adresini (google map adresi) de dinamik yani hücre adresinden alarak çalışabilecek şekilde dizayn etmiş.

 

[kumralyakisikli]

Videonun sağ alt kısmına dikkat edin; arka planda bir query table çalıştırmış. Ve bu table ın navigasyon adresini (google map adresi) de dinamik yani hücre adresinden alarak çalışabilecek şekilde dizayn etmiş.

Cevap için teşekkür ederim ama inanın dediklerinizden hiçbirşey anlamadım sanırım bunu anlamaya yetecek kadar excel bilmiyorum....

 

[Zeki Gürsoy]

Video dan bir alıntı çektim. Video da verilen örneğin adresine dikkat ederseniz daha iyi anlayacaksınız. Aşağıda İstanbul ve Artvin arası mesafeye ait sorgunun adresini görüyorsunuz.

.
.
.
.

 

[Zeki Gürsoy]

Ekli dosyayı inceleyin.

Kolay gelsin...

Dosyayı buradan indirebilirsiniz.

Sub test()
    Dim cls As New googleMAP, gzs As Guzergahlar
    
    Set gzs = cls.getMAP([b1], [b2])
    
    If gzs.Count > 0 Then
        MsgBox "'" & [b1] & "' ile '" & [b2] & "' arasında " & gzs.Count & " adet guzergah var." & vbCr & vbCr & _
               "Brinci güzergah :" & vbCr & vbCr & _
               "Mesafe    : " & gzs.Item(1).Mesafe & vbCr & _
               "Süre         : " & gzs.Item(1).Sure & vbCr & _
               "Karayolu : " & gzs.Item(1).Karayolu, vbInformation, " ::.. Zeki GÜRSOY ..:: "
    End If

End Sub

"googleMAP" class:

Option Explicit

Public Function getMAP(ByVal adr1 As String, ByVal adr2 As String) As Guzergahlar
    On Error Resume Next
    
    Dim ie As New InternetExplorer, ol As Object, li As Object, i As Integer
    Dim objGuzergahlar As New Guzergahlar, objGuzergah As Guzergah

    ie.Navigate "https://maps.google.com/maps?f=d&source=s_d&saddr=" & adr1 & "&daddr=" & adr2
    
    Do Until ie.ReadyState = 4: DoEvents: Loop
    Do While ie.Busy = True: DoEvents: Loop
    
    Set ol = ie.Document.getelementbyid("dir_altroutes_body")
    
    Set li = ol.getelementsbytagname("li")
    
    For i = 0 To li.Length - 1
        Set objGuzergah = New Guzergah
        
        objGuzergah.Karayolu = li(i).getelementsbytagname("div")(0).getelementsbytagname("div")(1).innertext
        
        objGuzergah.Sure = li(i).getelementsbytagname("div")(0).getelementsbytagname("div")(0). _
                            getelementsbytagname("span")(1).innertext
        
        objGuzergah.Mesafe = li(i).getelementsbytagname("div")(0).getelementsbytagname("div")(0). _
                            getelementsbytagname("span")(0).innertext
        
        objGuzergahlar.Add objGuzergah

    Next
    
    Set getMAP = objGuzergahlar
    
    ie.Quit

    If Err Then MsgBox Err.Description
End Function

"Guzergahlar" class:

Option Explicit

Private col As Collection

Friend Sub Add(objGuzergah As Guzergah)
    col.Add objGuzergah
End Sub

Public Property Get Item(id As Integer) As Guzergah
    Set Item = col(id)
End Property

Public Property Get Count() As Integer
    Count = col.Count
End Property

Private Sub Class_Initialize()
    Set col = New Collection
End Sub

"Guzergah" class:

Option Explicit

Private mMesafe   As String
Private mSure     As String
Private mKarayolu As String

Public Property Get Mesafe() As String
    Mesafe = mMesafe
End Property

Public Property Let Mesafe(ByVal vNewValue As String)
    mMesafe = vNewValue
End Property

Public Property Get Sure() As String
    Sure = mSure
End Property

Public Property Let Sure(ByVal vNewValue As String)
    mSure = vNewValue
End Property

Public Property Get Karayolu() As String
    Karayolu = mKarayolu
End Property

Public Property Let Karayolu(ByVal vNewValue As String)
    mKarayolu = vNewValue
End Property

 

[kumralyakisikli]

Çok teşekkür ederim

 

[bunyaming]

Değerli Arkadaşlar,
Epeydir, bu konu hakkında araştırıyorum buradan dosyayı da indirdim fakat hata veriyor. Konunun eski tarihli olduğunun farkındayım. Yardımcı olursanız çok sevinirim.

teşekkürler

 

[Zeki Gürsoy]

Evet, "map" sorgusu değişmiş.

Yeni sorgu şu şekilde. Ör:

Bolu Göynük ilçesinden, Sakarya Hendek ilçesine mesafe sorgu dizimi aşağıdaki gibidir.

https://www.google.com/maps/dir/Göynük,+Bolu,+Türkiye/Hendek,+Sakarya,+Türkiye

Unutmazsam kodu revize ederim.

 

[bunyaming]

teşekkürler hocam
kodları güncellediğiniz de beni büyük bir sıkıntıdan kurtacaksınız

 

[bunyaming]

yardım isteğim günceldir.

 

[Zeki Gürsoy]

yardım isteğim günceldir.

Bitmek üzeredir. Bittiğinde duyurulacaktır.