Hallo Daniel,
es freut mich, dass ich Dir helfen konnte.
Ich habe den Code jetzt so angepasst, dass die Bilder in der Größe 196 x 147 eingefügt werden. Ich habe jedes Bild mit einem Hyperlink versehen, so dass sich das Originalbild öffnet, wenn Du das Bild in Excel anklickst.
Ich habe die Änderungen fett markiert. Ich hoffe, das ist was Du Dir vorstellst.
Sub fotosEinfügen()
Dim sh As Shape, hyperLinkedShape As Shape
Dim ws As Worksheet
Dim strDateiPfad As String
Dim fs As Object, fPfad As Object, fFoto As Object, fFotos As Object
Dim i As Integer
Dim lz As Long
Dim strLecknummer As String, strLecknummerFoto As String
Dim laenge As Integer
'Annahme: Diese Datei liegt in dem Pfad, in dem die Bilder gespeichert sind
'Ich habe den Sheetnamen als "1" festgelegt. Bitte auf den entsprechenden Namen umändern
Set ws = Sheets("1")
strDateiPfad = ThisWorkbook.Path
'FileSystemObject erstellen um auf Ordner und Dateien zugreifen zu können
Set fs = CreateObject("scripting.FileSystemObject")
'Pfad festlegen, in dem die Fotos gespeichert sind
Set fPfad = fs.getfolder(strDateiPfad)
Set fFotos = fPfad.Files
With ws
For Each sh In ws.Shapes
sh.Delete
Next sh
'letzte Zeile ermitteln
lz = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lz
strLecknummer = .Cells(i, 1).Value
'Alle in dem Ordner gespeicherten Fotos durchlaufen
For Each fFoto In fFotos
If Left(fFoto.Name, 4) = "Leck" Then
'Länge des Fotonamens ermitteln
laenge = Len(fFoto.Name)
'Lecknummer aus Dateinamen ermitteln
'Dateiname: Leck 1-2.jpg
'-> Die ersten sieben und die letzten vier Zeichen müssen abgeschnitten werden, um die jeweilige Lecknummer zu ermitteln
'Diese wird mit der Lecknumme rin Spalte A verglichen
strLecknummerFoto = Mid(fFoto.Name, 6, (laenge - 11))
'Prüfung, ob die aktuelle Lecknummer der Nummer in dem Foto entspricht
If strLecknummer = strLecknummerFoto Then
'Aus dateinamen ermitteln ob es das Fot -2 oder -3 ist und entsprechend die Zelle festlegen, in der das Foto eingefügt werden soll.
If Left(Right(fFoto.Name, 5), 1) = "2" Then
'Einfügen des Fotos (40,40 bedeutet Breite, Höhe des Fotos in Pixeln
.Shapes.AddPicture fPfad & "\" & fFoto.Name, _
False, True, _
.Cells(i, 6).Left, _
.Cells(i, 6).Top, _
196, 147
Set hyperLinkedShape = .Shapes(.Shapes.Count)
ws.Hyperlinks.Add Anchor:=hyperLinkedShape, Address:=fFoto.Name
ElseIf Left(Right(fFoto.Name, 5), 1) = "3" Then
.Shapes.AddPicture fPfad & "\" & fFoto.Name, _
False, True, _
.Cells(i, 7).Left, _
.Cells(i, 7).Top, _
196, 147
Set hyperLinkedShape = .Shapes(.Shapes.Count)
ws.Hyperlinks.Add Anchor:=hyperLinkedShape, Address:=fFoto.Name
End If
End If
End If
Next fFoto
Next i
End With
End Sub
Viele Grüße
Kai
|