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
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