Guten Tag Karl-Heinz,
zunächst vielen Dank für deine Hilfe. Jedoch klappt es bei mir nicht so ganz. Sobald ich das Makro starte wird von dem jeweiligen Ordner, welches ich in 'spfad' eingegeben habe nur der Pfadname eines Bildes angezeigt. Also es erscheint garkein Bild. Vielleicht habe ich auch in den Anpassungen die ich vornehmen sollte etwas falsch gemacht ? Denn ich habe lediglich bei 'sPfad' den Pfad vom Ordner eingetragen wo sich die Bilder befinden. Bei 'sDatei' hab ich keine Anapssung vorgenommen, weil ich nicht weiß wofür das steht.
Sub Alle_Bilder_Einfügen()
Dim sDatei As String, sPfad As String
Dim oZelle As Range, oRette As Range
Dim ScaleA As Double
On Error Resume Next
Set oRette = ActiveCell
Set oZelle = Application.InputBox(Prompt:="Bitte Zielzelle wählen!", _
Default:=Cells(Rows.Count, "C").End(xlUp).Offset(1, -1).Address, Type:=8)
If oZelle Is Nothing Then Exit Sub
sPfad = "C:\der Ordner wo die Bilder sind" '<<<anpassen>>>
sDatei = Dir(sPfad & "*.*") '<<<anpassen>>>
Do While sDatei <> ""
Select Case LCase$(Right(sDatei, 4))
Case ".bmp", ".jpg", ".tif", ".gif", ".png", "jpeg"
With ActiveSheet.Pictures.insert(sPfad & sDatei)
With .ShapeRange
.Top = oZelle.Top
.Left = oZelle.Left
ScaleA = WorksheetFunction.Min(oZelle.Width / .Width, oZelle.Height / .Height)
.Height = .Height * ScaleA
End With
.Placement = xlMoveAndSize
.PrintObject = True
End With
Set oZelle = oZelle.Offset(1, 0) 'Nächstes Feld
End Select
sDatei = Dir
Loop
oRette.Select
End Sub
|