|
Hallo Elias,
hier mal ein (erste) Anregung, wie man das realsieren könnte.
Code passt das aktuelle Bild an das Zielfeld an und geht zum nächsten Feld über.
Je nach dem, was genau gewüscht wird, kann das ja noch angepasst werden.
Schau mal, ob Du damit etwas anfangen kannst.
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 = "D:\Pictures\Fotos\IGF\" '<<<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
viele Grüße
Karl-Heinz
|