Auto-resize Shape_width

[amrane]

dear Forum,

I am looking for your help regarding shape auto-resize based on a given cell value, for instance I am referring to a given number of stream crossing bottleneck, at the output, each stream will be treated based weight basis (refer to colored shape), so is it possible to:
Qts-1] Resize input an output shape according to the related cells value,
Qts-2] get the shape aligned every resize actions

thank you sir in advance for your support,

amrane,

[Bob Phillips]

Const startTop As Double = 70
Const startLeft As Double = 390
Const gap As Double = 5
Dim shp As Shape
Dim cell As Range
Dim heightOff As Double
Dim i As Long

With ActiveSheet

For Each cell In Range("B3", Range("B3").End(xlDown))

.Shapes("Rectangle " & Right$(cell.Value, 1)).Copy
.Paste
Selection.Name = cell.Value
Selection.Height = cell.Offset(0, 3).Value / 3.5
Selection.Left = startLeft
Selection.Top = startTop + heightOff
heightOff = heightOff + Selection.Height + gap
Next cell
End With