Datenüberprüfung Liste stört Bildeinfüge Makro

Sub Schaltfläche6_Klicken()

   Dim ws As Worksheet

    Dim img As Shape

    Dim cellRange As Range

    Dim imgWidth As Double

    Dim imgHeight As Double

    Dim imgRatio As Double

    Dim imgCellRatio As Double



    ' Das aktive Blatt setzen

    Set ws = ActiveSheet



    ' Bereich setzen, in den das Bild eingefügt werden soll

    Set cellRange = ws.Range("A37:D49")



    ' Überprüfen, ob das Clipboard ein Bild enthält (Format 9)

    If Application.ClipboardFormats(1) = 9 Then

        ' Bild einfügen und das eingefügte Bildobjekt referenzieren

        ws.Paste

        Set img = ws.Shapes(ws.Shapes.count)



        ' Größe des Bildes anpassen, um in die verbundenen Zellen zu passen

        With cellRange

            imgWidth = .Width

            imgHeight = .Height

        End With



        ' Seitenverhältnis des Bildes erhalten

        imgRatio = img.Width / img.Height

        imgCellRatio = imgWidth / imgHeight



        ' Bildgröße anpassen, um in die verbundenen Zellen zu passen und das Seitenverhältnis beizubehalten

        If imgRatio > imgCellRatio Then

            ' Wenn das Bild breiter ist als die Zelle, skaliere die Höhe entsprechend

            img.LockAspectRatio = msoTrue

            img.Width = imgWidth

        Else

            ' Andernfalls, skaliere die Breite entsprechend

            img.LockAspectRatio = msoTrue

            img.Height = imgHeight

        End If



        ' Bild in die Zelle A37 verschieben

        img.Top = cellRange.Top

        img.Left = cellRange.Left

    Else

        MsgBox "Das Format in der Zwischenablage entspricht nicht einem Bildformat (Format 9)."

    End If

End Sub