Liebe EXCELlenzen,

über über einen Hyperlink möchte ich ein Bild im Viewer aufrufen.
Das funktioniert mit dem gefunden Macro von Franz? aus 2013 gut.
Und ich kann es auch ein wenig anpassen, einiges schaffe ich nicht.
Das Makro soll erst in Zelle Q3 bis Qn die Hyperlinks reinschreiben.
Den Pfad zu den Bildern in Zelle A3 bis An möchte ich auch integrieren.

Bitte um Unterstützung.
Freundliche Grüsse aus Wien

Sub MakeHyperlinks()
'Hyperlinks für die Liste der Dateien im Blatt Wappen in Wappen erstellen ' Michael Ambrosch - Wappen
Dim wksListe As Worksheet, wksZiel As Worksheet
Dim ZeileHyplink As Long, ZeilePfad As Long
Dim SpaltePfad As Long, SpalteHypLink As Long, strDateiName As String
Set wksListe = ActiveWorkbook.Worksheets("Wappen") ' Michael Ambrosch - Blattname aus Zelle An OK
Set wksZiel = ActiveWorkbook.Worksheets("Wappen") ' MA - Blattname aus Zelle An OK
With wksZiel
SpalteHypLink = 17 'Spalte Q = Spalte für die Hyperlinks Michael Ambrosch
'Letzte Zeile in Hyperlinkspalte mit Dateneintrag
ZeileHyplink = .Cells(.Rows.Count, SpalteHypLink).End(xlUp).Row
If ZeileHyplink = 3 And IsEmpty(.Cells(1, SpalteHypLink)) Then ZeileHyplink = 0 ' Michael Ambrosch - .Cells(3, SpalteHypLink OK
End With
With wksListe
SpaltePfad = 6 'Spalte C = Spalte mit Dateiname+Pfad, SpaltePfad = 6 (F) Michael Ambrosch OK
Application.ScreenUpdating = False
For ZeilePfad = 3 To .Cells(.Rows.Count, SpaltePfad).End(xlUp).Row 'startzeile ggf. _
anpassen ' Michael Ambrosch - ZeilePfad = 3 OK
strDateiName = "bild_600\" & .Cells(ZeilePfad, SpaltePfad)
If Dir(strDateiName) = "" Then
With wksZiel
ZeileHyplink = ZeileHyplink + 1
'Dateiname ohne Verzeichnis in Zelle mit Link eintragen - der Text in der Zelle _
mit dem Hyperlink kann beliebig festgelegt werden
.Cells(ZeileHyplink, SpalteHypLink).Value _
= Mid(strDateiName, InStrRev(strDateiName, "\") + 1)
'Hyperlink für Datei anlegen - der Text für den Screnntip kann beliebig festgelegt _
werden
.Hyperlinks.Add anchor:=.Cells(ZeileHyplink, SpalteHypLink), _
Address:=strDateiName, _
ScreenTip:="Datei: " & strDateiName & vbLf _
& "Klick auf Dateiname zeigt Bild in Viewer an"
End With 'wksZiel
End If
Next ZeilePfad
End With 'wksListe
Application.ScreenUpdating = True
MsgBox "Fertig", vbInformation, "Hyperlinks erstellen"
End Sub