Hallo Jutta

Da ich schonmal etwas ähnliches hatte, habe ich mein Script mal auf deine Bedürfnisse angepasst.

Für die 50 verschiedenen Formen müsstest du 50x Case Situationen definieren.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim shp As Shape
    Dim objType As Integer
    
    ' Überprüfen, ob die Änderung in Spalte D liegt
    If Not Intersect(Target, Me.Columns("D")) Is Nothing Then
        ' Sicherstellen, dass der Wert eine Zahl ist
        If IsNumeric(Target.Value) Then
            objType = Target.Value ' Der Wert in der Zelle
            
            ' Entferne existierende Formen an der Position (optional)
            For Each shp In Me.Shapes
                If Not Intersect(shp.TopLeftCell, Target) Is Nothing Then
                    shp.Delete
                End If
            Next shp
            
            ' Prüfen, ob der Wert innerhalb der möglichen Formen liegt
            If objType >= 1 And objType <= 50 Then
                ' Füge die Form hinzu
                Select Case objType
                    Case 1
                        Set shp = Me.Shapes.AddShape(msoShapeRectangle, Target.Left, Target.Top, 50, 20)
                    Case 2
                        Set shp = Me.Shapes.AddShape(msoShapeOval, Target.Left, Target.Top, 50, 50)
                    Case 3
                        Set shp = Me.Shapes.AddShape(msoShapeRightArrow, Target.Left, Target.Top, 50, 20)
                    ' Weitere Formen hinzufügen nach Bedarf...
                    Case Else
                        MsgBox "Formtyp ist nicht definiert."
                End Select
                
                ' Optional: Name oder Position anpassen
                'shp.Placement = xlMoveAndSize
                'shp.Name = "Shape_" & objType
            Else
                MsgBox "Bitte eine Zahl zwischen 1 und 50 eingeben."
            End If
        End If
    End If
End Sub

Zum Grusse