bilder-import

[Flotter Feger]

Hallo,

wie gesagt, Office ist kein IrfanView ...

Dieser Code liest alle Bild-Dateien ein und markiert sie alle zusammen.

Code:

Option Explicit

Sub BilderImport()
'*********************************************************************************
'** Bilder werden in die Spalte A 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
Dim shp As Long
 
'** Verzeichnis und Dateinamen definieren und auslesen
strVerzeichnis = "E:\Excel\Bilder"
strDatei = Dir(strVerzeichnis & "\*.bmp")
 
'** Startzeile + Spalte festelegen
lngZeile = 5
lngSpalte = 1
 
'** Ermittlung der Spaltenbreite
varBreite = Columns("A:A").Width
 
shp = 1
'** Bild 1 bis n durchlaufen
Do While strDatei <> ""
   If strDatei = "" Then Exit Do
   Cells(lngZeile, lngSpalte).Select
   Set pct = ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei)
   pct.Name = "Picture " & shp
   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
   strDatei = Dir()

Loop
ActiveSheet.Pictures.Select
End Sub

Sabina