Hyperlink aus Bilder auslesen!

Wie kann man Hyperlinks die auf Bilder gelegt sind als Text auslesen? Im folgenden drei Beispiele. Einmal die Ausgabe im "Direkt-Fenster" (STRG+G im VBA-Editor), dann zwei Spalten neben dem Bild und schließlich die Ausgabe in einem anderen Tabellenblatt.

Hyperlink - in Bilder - als Text ausgeben...[ZIP, 150 KB]

Option Explicit
Sub Test_2()
Dim shpShape As Shape
For Each shpShape In ThisWorkbook.ActiveSheet.Shapes
With shpShape
If .Type = msoPicture Then
Debug.Print .Hyperlink.Address
Debug.Print .Name
Debug.Print .TopLeftCell.Address
End If
End With
Next shpShape
End Sub
Sub Test_1()
Dim shpShape As Shape
With ThisWorkbook.ActiveSheet
For Each shpShape In .Shapes
If shpShape.Type = msoPicture Then
.Cells(shpShape.TopLeftCell.Row, _
shpShape.TopLeftCell.Column + 2).Value = _
shpShape.Hyperlink.Address
End If
Next shpShape
End With
End Sub
Sub Test()
Dim varArr() As String
Dim shpShape As Shape
Dim lngTMP As Long
Redim varArr(1 To Tabelle1.Shapes.Count)
' eventuell anpasen!!!
For Each shpShape In Tabelle1.Shapes
With shpShape
If .Type = msoPicture Then
' später auskommentieren
Debug.Print .Hyperlink.Address
' später auskommentieren
Debug.Print .Name
' später auskommentieren
Debug.Print .TopLeftCell.Address
varArr(lngTMP + 1) = .Hyperlink.Address
lngTMP = lngTMP + 1
End If
End With
Next shpShape
Tabelle2.Range("A1").Resize(Ubound(varArr)) = _
WorksheetFunction.Transpose(varArr)
End Sub
' Tabelle1 UND Tabelle2 sind die Codenamen der Tabellenblätter
' Siehe auch VBA-Editor Name VOR der Klammer
' z. B. Tabelle1 (Tabelle1) bei neuer Datei und deutschem Excel
' Debug.Print ist nur zum testen drin - kann dann auskommentiert
' bzw. gelöscht werden

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...