Hallo zusammen,

ich möchte auf einem Excel-Formular in mehreren verbundenen Zellbereichen automatisch Bilder aus einem bestimmten Verzeichnis einfügen. Die Zellbereiche sind als Array definiert, der Pfad zu den Bildern ist als Variable definiert und der Name der Bildes steht im jeweiligen Zellbereich des Arrays.

Die Schleife soll jetzt jeden einzelnen Zellbereich des Arrays durchlaufen, sich mit dem dort stehenden Namen den kompletten Pfad zum Bild erstellen und dann dieses Bild in diesem Zellbereich mittig ausgerichtet mit Bildgröße in Abhängigkeit von Hoch- oder Querformat einfügen.

Leider habe ich noch einen Fehler in meinem Script und komme nicht weiter. In der Zeile

BildName = Range(arrBereiche(i)).Value

bekomme ich den Laufzeitfehler 13: Typen unverträglich

Was mache ich falsch? Vielleicht kann man hier jemand helfen.

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