Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1808to1812
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Hyperlink mit Bild'chen

Hyperlink mit Bild'chen
02.02.2021 18:42:06
schmik
Grüezi Experten,
ich bräuchte mal einen Denkanstoss respektive Eure Hilfe.
Ich habe mir eine

Sub zusammengebaut, welche aus einem Pfad (dieser befindet sich in Spalte A) alle pdf-datein  _
sucht und diese dann als kleines Bild mit hinterlegtem Hyperlink in die zugehörige Zeile  _
ausgibt.
Nun möchte ich zusätzlich auch noch weitere files (*.doc, *.xls, etc.) auf selbe Art aufführen.  _
_
Der Knackpunkt ist für mich unter anderem auch die zuordnung des zugehörigen Icon-Pics.
Kann mir jemand sagen, ob ich den Dir()befehl mit zusätzlichen Dateitypen (und natürlich  _
entsprechendem Icon) erweitern kann bzw. wie eine Schleife aussehen müsste? Und als i-Tü _
pfelchen wäre natürlich der Hammer, wenn die Auflistung "sortiert" wäre...also erst alle pdf-Links, dann die doc-Links, usw. Ich hoffe, dass ich mich nicht allzu unverständlich ausgedrückt habe :-)
Der 

Sub für ein Typ wäre der folgende:

Sub Hyperlink()
Dim Icon As Picture
Dim PDFpfad As String
Dim DOCpfad As String
Dim XLSpfad as String
Dim i%, Gr%
Dim FN$, Pfad$, Ext$
Dim Obj(100)
PDFpfad = "C:\Users\Icons\file-pdf-icon.png"
DOCpfad = "C:\Users\Icons\file-code-icon.png"
XLSpfad = "......."
Dim k%, lz%
With ThisWorkbook.ActiveSheet
lz = .Cells(Rows.Count, 1).End(xlUp).Row
For k = 2 To lz
Pfad = .Cells(k, 1)
Ext = "*.pdf"
FN = Dir(Pfad & Ext)
Gr = 25
i = 1
With ThisWorkbook.ActiveSheet
.Cells(k, 8).Select
Do While Len(FN) > 0
Set Obj(i) = ActiveSheet.Pictures.Insert(PDFpfad)
With Obj(i)
.Height = Gr
.ShapeRange.Top = ActiveSheet.Cells(k, 8).Top + (ActiveSheet.Cells(k, 8).Height - Obj( _
_
i).ShapeRange.Height) / 2
.ShapeRange.IncrementLeft (i - 1) * (Gr + 5)
End With
With ThisWorkbook.ActiveSheet
.Hyperlinks.Add Anchor:=.Shapes(Obj(i).Name), Address:=Pfad & FN, ScreenTip:=FN
End With
FN = Dir()
i = i + 1
Loop
End With
Next k
End With
End Sub

Ich freue mich sehr über Eure Denkanstösse!

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hyperlink mit Bild'chen
03.02.2021 08:09:50
schmik
Hmm...niemand einen Tipp?
AW: Hyperlink mit Bild'chen
03.02.2021 09:17:54
volti
Hallo schmik,
evtl. wäre eine Beispielmappe sinnvoll, anhand der man das auch mal testen könnte. Ohne Mappe lässt sich das schlecht nachvollziehen.
Dann empfehle ich anstelle von InsertPicture besser die AddPicture-Methode zu verwenden.
siehe Beispiel:
Code:

[Cc]

Sub Bild_einfügen_und_Anpassen_Aus_Datei() ' Fügt ein Bild aus einer Datei ein und passt es an Dim sPic As Variant, oPic As Shape sPic = Application.GetOpenFileName _ ("Pictures (*.gif; *.jpg; *.bmp; *.tif; *.jxr), *.gif; *.jpg; *.bmp; *.tif; *.jxr", _ , "Bild auswählen") If sPic Then Set oPic = ActiveSheet.Shapes.AddPicture(FileName:=sPic, LinkToFile:=msoFalse, _ SaveWithDocument:=msoTrue, Left:=Selection.Left, _ Top:=Selection.Top, WIDTH:=-1, HEIGHT:=-1) With oPic .LockAspectRatio = msoTrue .HEIGHT = .TopLeftCell.HEIGHT .Placement = xlMoveAndSize End With Set oPic = Nothing End If End Sub

Zum Setzen der "Bildchen" empfiehlt sich ein Vorgehen wie in diesem Link beschrieben:
Link
viele Grüße
Karl-Heinz
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige