Bilder einf Antwort auf älteren Beitrag
18.01.2021 20:02:52
Patrick
ich hatte vor einiger Zeit eine Frage gestellt und hatte leider keine Zeit rechtzeitig zu Antworten, aus diesem Grund ein neuer Beitrag.
Der Beitrag um den es geht ist dieser: https://www.herber.de/forum/archiv/1792to1796/t1794232.htm
der Code von ralf_b funktioniert an und für sich. Nur die Größe der Bilder wird auf die Zellhöhe und Zellbreite angepasst und somit wird das Bild verzerrt. die Bilder sollen aber nur an die Höhe der Zelle angepasst und das Seitenverhältnis vom Original beibehalten werden.
Mein aktueller Code:
Sub Covereinfügen()
Dim Dat As String
Dim Zelle As Range
Dim ScaleA As Double
'Bild auswählen
Dat = Application.GetOpenFilename(, , "Bild auswählen", , False)
Set Zelle = Cells(Range("A1").End(xlDown).Row + 0, 11)
'Bild einfügen
Select Case Right(Dat, 3)
Case "bmp", "jpg", "tif", "gif", "jpeg"
ActiveSheet.Shapes.AddPicture Dat, False, True, Zelle.Left, Zelle.Top, Zelle.Width, _
Zelle.Height
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
ScaleA = WorksheetFunction.Min(Zelle.Width / .Width, Zelle.Height / .Height)
.Height = Zelle.Height * ScaleA
End With
Case Else
MsgBox "Sie haben kein gültiges Bild ausgewählt"
End Select