Weil das ganze schreiben des Codes ein bisschen mühsam sein kann, hier zur erstellung der Cases:

Sub GenerateShapeCaseCode()
    Dim ws As Worksheet
    Dim shp As Shape
    Dim newWs As Worksheet
    Dim codeRow As Long
    Dim codeLine As String
    Dim caseNumber As Long

    ' Neue Arbeitsmappe erstellen
    Set newWs = Workbooks.Add.Worksheets(1)
    newWs.Name = "Generated Code"
    newWs.Cells(1, 1).Value = "VBA Code für Shapes"
    codeRow = 2 ' Start in der zweiten Zeile
    caseNumber = 1 ' Zählt die Cases hoch

    ' Formen aus dem aktiven Arbeitsblatt durchgehen
    Set ws = ActiveSheet
    For Each shp In ws.Shapes
        ' Basis-Code für die Form
        codeLine = "Case " & caseNumber & vbCrLf
        codeLine = codeLine & "    Set shp = Me.Shapes.AddShape(" & shp.AutoShapeType & ", Target.Left, Target.Top, " & _
                   shp.Width & ", " & shp.Height & ")" & vbCrLf

        ' Fülleffekt hinzufügen (falls vorhanden)
        On Error Resume Next ' Falls keine Füllung gesetzt ist
        If Not shp.Fill.Visible = msoFalse Then
            codeLine = codeLine & "    shp.Fill.ForeColor.RGB = " & shp.Fill.ForeColor.RGB & vbCrLf
            codeLine = codeLine & "    shp.Fill.BackColor.RGB = " & shp.Fill.BackColor.RGB & vbCrLf
            codeLine = codeLine & "    shp.Fill.Transparency = " & shp.Fill.Transparency & vbCrLf
        End If
        On Error GoTo 0

        ' Formkontur hinzufügen (falls vorhanden)
        If shp.Line.Visible Then
            codeLine = codeLine & "    shp.Line.ForeColor.RGB = " & shp.Line.ForeColor.RGB & vbCrLf
            codeLine = codeLine & "    shp.Line.Weight = " & shp.Line.Weight & vbCrLf
            codeLine = codeLine & "    shp.Line.Transparency = " & shp.Line.Transparency & vbCrLf
        End If

        ' Text-Ausrichtung (falls Text enthalten ist)
        If shp.TextFrame2.TextRange.Text <> "" Then
            codeLine = codeLine & "    shp.TextFrame2.TextRange.Text = """ & shp.TextFrame2.TextRange.Text & """" & vbCrLf
            codeLine = codeLine & "    shp.TextFrame2.VerticalAnchor = " & shp.TextFrame2.VerticalAnchor & vbCrLf
            codeLine = codeLine & "    shp.TextFrame2.HorizontalAnchor = " & shp.TextFrame2.HorizontalAnchor & vbCrLf
            codeLine = codeLine & "    shp.TextFrame2.TextRange.Font.Size = " & shp.TextFrame2.TextRange.Font.Size & vbCrLf
            codeLine = codeLine & "    shp.TextFrame2.TextRange.Font.Name = """ & shp.TextFrame2.TextRange.Font.Name & """" & vbCrLf
        End If

        ' Generierten Code in die neue Arbeitsmappe schreiben
        newWs.Cells(codeRow, 1).Value = codeLine
        codeRow = codeRow + 1
        caseNumber = caseNumber + 1
    Next shp

    MsgBox "Code wurde generiert und in eine neue Arbeitsmappe geschrieben.", vbInformation
End Sub

Das Script geht durch das Dokument in welchem du deine Shapes hast, jede einzelne Form geht es durch und schreibt es für jedes Case den Scripttext in eine neue Mappe.

Viel Spass damit.