Hallo an die Spezialisten!
Ich hätte da eine Frage, vielleicht könnt ihr mir weiter Helfen.
Ich habe mir nun eine Datenbank in Mappe 1 erstellt, in Mappe 2 Befindet sich meine Vorlagemaske, welche mit SVERWEIS schon richtig befüllt wird.
Nun wollte ich euch fragen ob es möglich wäre, die dazugehörigen Bilder auch automatisch einfügen zu lassen.
ZB OZ10 (Name) steht in Zelle J2, nun möchte ich das dazugehörige Foto aus dem Ordner OZ10 aber in Zelle E66 einfügen.
Meine Frage, gibt es Makros die Spalte mit den Ordner abgleicht und daraus dann 2 Bilder (zb 1 und 2) in eine Zelle in bestimmter größe (8x10cm) ausspielt?
Wäre dankbar wenn jemand einen Tipp hat (ohne womöglich meine gesamten Bilder auszuwählen und umzubenennen). Leider helfen mir die anderen Makros nicht weiter.
Danke.
LG
Hier im Anhang findet ihr meinen bisherigen Code:
Bild wird schon in richtiger Größe geladen, aber leider schaff ich es nicht dieses in einer bestimmten Zelle darzustellen.
Vermutlich wird mir denk ich auch nichts anderes übrig bleiben, als einen Ordner mit allen Bildern mit Namenszuordnung anzulegen. So wird dan leider nur ein Bild eingefügt.
Sub BilderImport()
Dim strVerzeichnis$, strDatei$
Dim pct As Picture
Dim lngZeile As Long 'Zeile zum Eintragen der Bilder
Dim lngSpalte As Long 'Spalte zum Eintragen der Bilder
Dim varBreite As Variant 'Spaltenbreite
Dim varHoehe As Variant
'** Verzeichnis und Dateinamen definieren und auslesen
strVerzeichnis = "P:\Test\Foto1"
strDatei = Dir(strVerzeichnis & "\*.jpg")
'** Startzeile + Spalte festelegen
lngZeile = 2
lngSpalte = 7
'** Ermittlung der Spaltenbreite
varBreite = Columns("F:F").Width
Cells(lngZeile, lngSpalte).Select
'Cells(lngZeile, lngSpalte + 1) = strDatei ' schreiben Dateinamen
Set pct = ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei)
'With ActiveSheet.Shapes("Picture 1")
'** Auslesen der Breite
With pct
.Top = 200
.Left = 400
.Width = 400
.Height = 200
End With
shp = 2
lngZeile = lngZeile + 1
Do While strDatei <> ""
strDatei = Dir()
If strDatei = "" Then Exit Do
Cells(lngZeile, lngSpalte).Select
Set pct = ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei)
shp = shp + 1
Loop
End Sub