Hyperlink zu Google Maps

[mellow]

Code:

Sub Makro1()
'
' Makro1 Makro
'

'
    ActiveSheet.Shapes.Range(Array("Picture 2")).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:= _
        "https://www.irgendwo.de"
    Range("E1").Select
End Sub

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngTMP As Range
    On Error GoTo Fin
    Application.EnableEvents = False
    ' Nur Spalte F und ab Zeile 8
    If Target.Column = 6 And Target.Row > 7 Then
        ' Wenn mehrere Zellen, dann...
        For Each rngTMP In Target
            If Trim(rngTMP.Value) <> "" Then
                rngTMP.Offset(, -4).Value = 0
                rngTMP.Offset(, -5).Value = "X"
                rngTMP.Offset(, 7).Hyperlinks.Add Anchor:=rngTMP.Offset(, 7), _
                    Address:="https://www.google.de/maps/place/" & _
                    rngTMP.Offset(, 8) & ",+" & rngTMP.Offset(, 1), _
                    TextToDisplay:="Link Google Maps"
            Else
                rngTMP.Offset(, -4).Value = ""
                rngTMP.Offset(, -5).Value = ""
                rngTMP.Offset(, 7).Value = ""
            End If
        Next rngTMP
    End If
Fin:
    Application.EnableEvents = True
End Sub

Kann man das nicht da irgendwie mit einbauen ? das er mir statt den Link google maps ein symbol von google maps anzeigt.

Danke für eure Hilfe 

[schauan]

Hi Boris,

also, die Funktion funktioniert.
Der erste Zellinhalt geht nur als String, also z.B. Gera, 07549 Gera, ... beim zweiten reicht eine PLZ als String, z.B. '08058
Die Rückgabe ist die Entfernung in Metern.

Da muss was mit dem key nicht stimmen.

Hier nochmal der Code wie er in Herber gepostet ist. Ich hab nur auf die Schnelle die restlichen Strings deklariert und die Objekte als Variant

Code:

Option Explicit

'Calculate Google Maps distance between two addresses
Public Function GetDistance(start As String, dest As String)
    Dim firstVal As String, secondVal As String, lastVal As String, tmpVal As String, URL As String
    Dim objHTTP, regex, matches
    firstVal = "https://maps.googleapis.com/maps/api/distancematrix/json?origins="
    secondVal = "&destinations="
    lastVal = "&mode=car&language=en&sensor=false&key=" & Tabelle1.Range("B1")
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    URL = firstVal & Replace(start, " ", "+") & secondVal & Replace(dest, " ", "+") & lastVal
    objHTTP.Open "GET", URL, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    If InStr(objHTTP.responseText, """distance"" : {") = 0 Then GoTo ErrorHandl
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """value"".*?([0-9]+)": regex.Global = False
    Set matches = regex.Execute(objHTTP.responseText)
    tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
    GetDistance = CDbl(tmpVal)
    Exit Function
ErrorHandl:
    GetDistance = -1
End Function

[{Boris}]

Hi André,

klasse - das motiviert mich, das auch zu Laufen zu bekommen!

Da muss was mit dem key nicht stimmen.

Das vermutet ich ja auch - und glaube, dass es etwas mit dem OAuth-Zustimmungsbildschirm zu tun hat, denn

- den API-Key habe ich definitiv und
- eine Zahlungsmethode ist bei meinem Google-Konto auch hinterlegt (was ja Voraussetzung ist, auch wenn es erstmal nix kostet)

Kannst Du mir dabei vielleicht "das Händchen führen"? Können wir auch gerne außerhalb des Forums machen!

[00202]

Hallo,  

für Entfernungsberechnung nutze ich seit Jahren "Bing". In vielen Themen sieht man die Probleme mit Google. Die Krux ist, Google versucht eine Diva zu sein - es hat aber bisher nur zur Zicke gereicht.

Auch für Bing benötigst du einen "API-Key". Bei mir brummt das - wie gesagt - seit Jahren.

Machs per Bing...

[{Boris}]

Hi Case,

danke Dir! Das ist dann Plan B, falls ich die Diva nicht gebändigt kriegen sollte ,-)
Bing-UDF ist auf jeden Fall mal gespeichert!

[schauan]

Hallo mellow,

mein Code greift einmalig auf ein vorhandenes picture 2 zu.
Dein Code geht in einer Schleife über mehrere Zellen.

Um das in einer Schleife mit Bildern zu machen, müsste man wissen, wie vorhandene Bilder heißen, zugeordnet dem jeweiligen Link. Es würde ja nichts bringen, wenn ein Bild aus Zeile 2 den Link von Zeile 17 enthält. Du musst da auch aufpassen, dass Dir kein Spaßvogel Deine Ordnung durcheinander bringt. Geht ja schnell, vor allem, wenn Du überall das gleiche Symbol verwendest.

Wenn Du aber in der Zelle z.B. ein Symbol aus Webdings oder Wingdings oder wie auch immer die Schriftsätze heißen, unterbringen kannst, braucht man keine Bilder irgendwie zuordnen.

Arbeitsblatt mit dem Namen 'Tabelle1'
	A
1	ü

Verwendete Systemkomponenten: [Windows (64-bit) NT 10.00] / MS Excel 365

Diese Tabelle wurde mit Tab2Html (v2.7.1) erstellt. ©Gerd alias Bamberg

der Code würde im Prinzip so aussehen:

Code:

Sub Makro1()
    With ActiveCell
      .Value = "ü"
      With .Font
        .Name = "Webdings"
        .Size = 36
      End With
    End With
End Sub