Attach VBA Class Object to Visio shape

Question

Question

I have a shape in visio 2021 , which is the "GRID" found in "Charting Shapes" I would like to scale the smaller shapes in the master according to the ratios. Therefore I would like to bind a new instance of the class I created below to my master, and then be able to resize the master, which intern would scale the components relative to the ratios.

Code

Class name = LWR_Calc

Private Widths() As Double
Private Heights() As Double
Private W, H As Double
Private TotalWidthRatio, TotalHeightRatio
Private WidthRatioSubDivision, HeightRatioSubDivision


Private Sub Class_Initialize()
W = 1
H = 1
End Sub

Public Sub SetWidths(Lst As String, Optional delimiter As String = ",")
    Dim WidthsRatioStrArr() As String
    Dim Current As Double

    WidthsRatioStrArr = Split(Lst, delimiter)
    TotalWidthRatio = 0

    ReDim Widths(0 To UBound(WidthsRatioStrArr))

    For i = 0 To UBound(WidthsRatioStrArr)
        Current = CDbl(WidthsRatioStrArr(i))
        Widths(i) = Current
        TotalWidthRatio = TotalWidthRatio + Current
    Next
    WidthRatioSubDivision = W / TotalWidthRatio
End Sub

Public Sub SetHeights(Lst As String, Optional delimiter As String = ",")
    Dim HeightsRatioStrArr() As String
    Dim Current As Double

    HeightsRatioStrArr = Split(Lst, delimiter)
    TotalHeightRatio = 0

    ReDim Heights(0 To UBound(HeightsRatioStrArr))
    For i = 0 To UBound(HeightsRatioStrArr)
        Current = CDbl(HeightsRatioStrArr(i))
        Heights(i) = Current
        TotalHeightRatio = TotalHeightRatio + Current
    Next
    HeightRatioSubDivision = H / TotalHeightRatio
End Sub

Public Function GetHeight(ByVal index As Integer) As Double
    On Error GoTo endr:
    GetHeight = Heights(index - 1) * HeightRatioSubDivision
    Exit Function
endr:
    GetHeight = 0
End Function

Public Function GetWidth(ByVal index As Integer) As Double
    On Error GoTo endr:
    GetWidth = Widths(index - 1) * WidthRatioSubDivision
    Exit Function
endr:
    GetWidth = 0
End Function


Public Property Let Width(ByVal vNewValue As Double)
    W = vNewValue
End Property

Public Property Let Height(ByVal vNewValue As Double)
    H = vNewValue
End Property

my sub which tests the code is as follows

Private Sub Test__LWR_Calc()
    Dim LWRC As LWR_Calc
    Set LWRC = New LWR_Calc
    LWRC.Height = 2
    LWRC.Width = 10
    LWRC.SetWidths ("1.75,1,1,1,1,1,1,1,1,1")
    LWRC.SetHeights ("1.75,1,1,1.75,1,1,1,1,1,1")
    For i = 1 To 10
        For j = 1 To 10
        Debug.Print i & "-" & j & "    "; LWRC.GetWidth(j) & " , " & LWRC.GetHeight(i)
        Next
    Next
    Set LWRC = Nothing
End Sub

This code works to get the values below

Data

Output

The Outputs I Get vs the Output I Want.