Sub Bild1()
Dim varBild As Variant
Dim Zelle As Range
Dim ScaleA As Double
Set Zelle = Range("B318", "U339")
varBild = Application.GetOpenFilename(Title:="Test")
If varBild = False Then Exit Sub
ActiveSheet.Unprotect Password:="1234"
ActiveSheet.Pictures.Insert(varBild).Select
With Selection.ShapeRange
.Top = Zelle.Top
.Left = Zelle.Left
ScaleA = WorksheetFunction.Min(Zelle.Width / .Width, Zelle.Height / .Height)
.Height = .Height * ScaleA
End With
Selection.Placement = xlMoveAndSize
Selection.PrintObject = True
ActiveSheet.Protect Password:="1234"
End Sub