Guten Tag,

ich hoffe hier auf Hilfe anzutreffen.

Ich versuche Bilder (EPS-Dateiformat) aus einer Datei in mein Excel-Sheet einzubinden. Pro Zeile ein Bild. Ich habe den u.g. Code, er funktioniert auch bzgl. "Dateizugriff". Allerdings werden die Bilder alle an einer Stelle platziert und nicht wie per Code-Definitionen Zeile für Zeile in eine bestimmte Spalte.

Ich wäre Ihnen sehr dankbar, wenn Sie mir weiterhelfen könnten:

Sub BilderImport()
'*********************************************************************************
'** Bilder werden in die Spalte X eingefügt. Die Bilder werden auf die  **
'** eingestellte Spaltebreite skaliert. Die Zeilenhöhe wird an die         **
'** skalierte Bildhöhe angepasst                                                     **
'*********************************************************************************

'* * Dimensionierung der Variablen
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 = "C:\XXX EPS-Datei"
strDatei = Dir(strVerzeichnis & "\*.eps")

'** Startzeile + Spalte festlegen
lngZeile = 2
lngSpalte = 4

'** Ermittlung der Spaltenbreite
varBreite = Columns("A:A").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
'  ActiveSheet.Shapes("Picture 1").Select
 ' Selection.ShapeRange.LockAspectRatio = msoTrue
 
  '** Bild auf aktuelle Spaltenbreite skalieren
  'Selection.ShapeRange.Width = varBreite
 
  '** Zeilenhöhe festlegen
  'varHoehe = ActiveSheet.Shapes("Picture 1").Height
  'Rows(lngZeile).RowHeight = varHoehe
'End With

'** Zähler für Shape definieren
shp = 2

'** Zeilenzähler erhöhen
lngZeile = lngZeile + 1


'** Bild 2 bis n durchlaufen
Do While strDatei <> ""
  strDatei = Dir()
  If strDatei = "" Then Exit Do
  Cells(lngZeile, lngSpalte).Select
  Set pct = ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei)
  'ActiveSheet.Shapes("Picture " & shp).Select
  'Cells(lngZeile, lngSpalte + 1) = strDatei  ' schreiben Dateinamen
  'Selection.ShapeRange.LockAspectRatio = msoTrue
 
  'Selection.ShapeRange.Width = varBreite '* 5.355 'Bild auf Spaltenbreite skallieren
 
  '** Zeilenhöhe festlegen
 ' varHoehe = ActiveSheet.Shapes("Picture " & shp).Height
 ' Rows(lngZeile).RowHeight = varHoehe
 
  '** Zeilenzähler erhöhen
  lngZeile = lngZeile + 1
 
  '** Shape-Zahler erhöhen
  shp = shp + 1
 
Loop
End Sub