Figurer i Excel

Lidt til at "lege" videre med:
PS: Når etagerne er afsat så klik i "huset" så vises disse - har ikke kunne finde et udtryk herfor.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$G$12" Then
        Shapes("Rektangel 1").Width = Target.Value
    End If
   
    If Target.Address = "$G$11" Then
        Shapes("Rektangel 1").Height = Target.Value
    End If
   
    If Target.Address = "$G$10" Then
        afsætAntalEtager Target.Value
    End If
End Sub
Private Sub afsætAntalEtager(antalEtager)
Dim venstre As Double, bredde As Double, højde As Double, top As Double, i As Integer
    sletGlEtager

    With Shapes("Rektangel 1")
        venstre = .Left
        bredde = .Width
        højde = .Height
        top = .top
    End With

    For i = 1 To antalEtager - 1
        ActiveSheet.Shapes.AddConnector(msoConnectorStraight, venstre, top + (højde / antalEtager) * i, venstre + bredde, _
            top + (højde / antalEtager) * i).Select
        Selection.ShapeRange.ShapeStyle = msoLineStylePreset1    '7
    Next i
End Sub
Private Sub sletGlEtager()
Dim antalSh As Integer, sh As Object
    antalSh = ActiveSheet.Shapes.Count
    If antalSh > 1 Then
        For Each sh In ActiveSheet.Shapes
            If sh.Name <> "Rectangle 1" Then
                sh.Delete
            End If
        Next sh
    End If

    ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select
End Sub

Mega sejt tak :)

Selv tak
PS: Hvis du vil give point - så skal du accepterer mit svar og afvise dit eget.