Attach VBA Class Object to Visio shape - vba

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.