Sub BilderEinfuegen_Test_neu()
Dim i As Long
Dim PicBild As Picture
Dim PfadDatei$, PfadBilder$, BildName$
Dim arrBereiche As Variant
arrBereiche = Array("A6:L24", "N6:Y24", "A28:L46", "N28:Y46", "A51:L69", "N51:Y69", "A73:L91", "N73:Y91", _
"A96:L114", "N96:Y114", "A118:L136", "N118:Y136", "A141:L159", "N141:Y159", "A163:L181", "N163:Y181", _
"A186:L204", "N186:Y204", "A208:L226", "N208:Y226")
PfadDatei = ThisWorkbook.Path
PfadBilder = PfadDatei & "\Bilder\"
Application.ScreenUpdating = False
For i = 0 To UBound(arrBereiche)
BildName = Range(arrBereiche(i)).Value
Set PicBild = _
ActiveSheet.Pictures.Insert(PfadBilder & BildName & ".jpg")
With ActiveSheet.Pictures(ActiveSheet.Pictures.Insert)
PicBild.Top = Range(arrBereiche(i)).Top
PicBild.Left = Range(arrBereiche(i)).Left
If ActiveSheet.Pictures(ActiveSheet.Pictures.Insert).Width > _
ActiveSheet.Pictures(ActiveSheet.Pictures.Insert).Height Then
PicBild.Width = Range(arrBereiche(i)).Width
PicBild.Top = Range(arrBereiche(i)).Top + _
(Range(arrBereiche(i)).Height - ActiveSheet.Pictures(ActiveSheet.Pictures.Insert).Height) / 2
Else
PicBild.Height = Range(arrBereiche(i)).Height
PicBild.Left = Range(arrBereiche(i)).Left + _
(Range(arrBereiche(i)).Width - ActiveSheet.Pictures(ActiveSheet.Pictures.Insert).Width) / 2
End If
End With
Next i
Application.ScreenUpdating = True
Set PicBild = Nothing
End Sub