Moin zusammen,

ich bin aktuell an einem Code dran, welcher mir ein Bild auf ein vordefiniertes Maß zuschneiden soll (nicht auf das Maß vergrößern/verkleinern). Folgenden Code habe ich hierzu erstellt:

Sub test1()

Dim Auswahl As String
Dim Auswahl_Bild As Shape
Dim Auswahl_Height As Long
Dim Auswahl_Width As Long
Dim Bild_Height As Long
Dim Bild_Width As Long

Auswahl = Application.GetOpenFilename(FileFilter:="Bilddateien (*.jpg), *.jpg", Title:="Eine oder mehrere Dateien zum Öffnen auswählen")

If Auswahl = "Falsch" Then
Exit Sub
End If

'vorgegebenes Maß:
Bild_Height = 200
Bild_Width = 300

ActiveSheet.Pictures.Insert Auswahl

Set Auswahl_Bild = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)

With Auswahl_Bild

Auswahl_Height = .Height
Auswahl_Width = .Width

If Bild_Height < Auswahl_Height Then

Bild_Height = (Auswahl_Height - Bild_Height) / 2

Else

MsgBox "Das ausgewählte Bild hat nicht die richte Maße.", vbInformation, "Nicht alle Voraussetzungen wurden erfüllt"

End If

If Bild_Width < Auswahl_Width Then

Bild_Width = (Auswahl_Width - Bild_Width) / 2

Else

MsgBox "Das ausgewählte Bild hat nicht die richte Maße.", vbInformation, "Nicht alle Voraussetzungen wurden erfüllt"

End If

.LockAspectRatio = msoFalse

.PictureFormat.CropLeft = Bild_Width
.PictureFormat.CropTop = Bild_Height
.PictureFormat.CropRight = Bild_Width
.PictureFormat.CropBottom = Bild_Height

.LockAspectRatio = msoTrue

Auswahl_Height = .Height
Auswahl_Width = .Width

End With

End Sub

Nur das Zuschneiden auf mein vorgegebenes Maß klappt noch nicht so ganz. Kann man mit der ".Crop" Eigenschaft nicht 1:1 Punkte wegnehmen oder muss ich meinem Wert umrechnen, damit die ".Crop" Eigenschaft das sauber übernehmen kann ?

Gruß

Lukas