Excel VBA: Create shapes hierarchy from list - vba

Question

I'm trying to loop through an "ordered" list to create several rectangle shapes in hierarchy style (and link them with elbow connectors). Example: on my WBSdata sheet, I have the following
A B
1 0. Box 0. lvl1
2 0.1. Box 0.1. lvl2
3 Comment 1
4 Comment 2
5 0.1.1. Box 0.1.1. lvl3
6 Comment 1
7 Comment 2
8 Comment 3
9 0.2. Box 0.2. lvl2
10 0.2.1. Box 0.2.1. lvl3
11 0.2.2. Box O.2.1. lvl3
12 Comment 1
13 Comment 2
14 1. Box 1. lvl1
15 Comment 1
16 Comment 2
17 1.1. Box 1.1. lvl2
Would output something like this on the WBS sheet:
Basically, read the "index" in column A, if it's first level (2 characters in column A), draw a blue box and write the corresponding value from column B, then look at the line below, if it's a level 2 box (4 characters), draw it below (a bit shorter on the left side), assign it the value ; same for lvl 3 box. If column A i empty, create a text box below the shape, and add all the comments.
So far (see code below), I managed to create a box (yay), style it and add the text, as well as create a text box (with a line on the side, like in the picture, but i'd need it to be the same "dynamic" height as the text box), but i can't get it to add all the comments. I can't get the magic to understand that it needs to move to the next "level" (go from blue box to green box for example).
I haven't yet tried to connect each box to its "hierarchical superior", but that's another story :)
I'm pretty sure i'm not managing my variables correctly (mainly the counter), making it reset at the right time, etc...
Any tips to send me on the right direction?
Public Sub wbsShape()
Dim wbs, wbsdata As Worksheet
Set wbs = ThisWorkbook.Sheets("WBS")
Set wbsdata = ThisWorkbook.Sheets("WBSdata")
i = 2 'counter, because data starts on line 2
ileft = 100 'initial position from left of sheet
itop = 100 'initial position from top of sheet
lg = 175 'main box width
ht = 50 'main box height
ind = 10 'indent (for lines, or smaller boxes)
impred = RGB(128, 0, 0) 'red
impgreen = RGB(0, 128, 0) 'green
impblue = RGB(0, 0, 128) 'blue
impgrey = RGB(200, 200, 200) 'light grey for border
black = RGB(0, 0, 0)
white = RGB(255, 255, 255)
Do While Not IsEmpty(wbsdata.Cells(i, "A").Value)
With wbs.Shapes.AddShape(msoShapeRectangle, ileft, itop, lg, ht)
.Fill.ForeColor.RGB = impblue
.Line.ForeColor.RGB = impgrey
.Line.Weight = 1
.Name = wbsdata.Cells(i, "B").Value
With .TextFrame
With .Characters
.Text = UCase(wbsdata.Cells(i, "B").Value)
With .Font
.Color = white
.Name = "Arial"
.Size = 14
.FontStyle = "Bold"
End With
End With
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
End With
End With
i = i + 1
If IsEmpty(wbsdata.Cells(i, "A").Value) Then
wbs.Shapes.AddLine(ileft + ind, itop + ht, ileft + ind, itop + ht + 100).Line.ForeColor.RGB = RGB(10, 10, 10)
With wbs.Shapes.AddTextbox(msoTextOrientationHorizontal, ileft + 2 * ind, itop + ht, lg - ind, 30)
.Line.Visible = msoFalse
.Fill.Transparency = 1
With .TextFrame.Characters
.Font.Name = "Arial"
.Text = wbsdata.Cells(i, "B").Value
End With
End With
End If
itop = itop + ht + 20
Loop
End Sub

Answer 1

I think this is going to be a lot of work (I've stripped out a lot of your formatting), but perhaps this will start you off in the right direction.
Sub x()
Dim r As Range, v, s As Shape
ileft = 100 'initial position from left of sheet
itop = 100 'initial position from top of sheet
lg = 175 'main box width
ht = 50 'main box height
ind = 10 'indent (for lines, or smaller boxes)
impred = RGB(128, 0, 0) 'red
impgreen = RGB(0, 128, 0) 'green
impblue = RGB(0, 0, 128) 'blue
impgrey = RGB(200, 200, 200) 'light grey for border
black = RGB(0, 0, 0)
white = RGB(255, 255, 255)
For Each r In Range("A1:A4")
v = Split(r, ".")
If UBound(v) = 1 Then
Set s = ActiveSheet.Shapes.AddShape(msoShapeRectangle, ileft, itop, lg, ht)
s.Fill.ForeColor.RGB = impblue
s.TextFrame.Characters.Text = r.Offset(, 1)
itop = itop + 75
ElseIf UBound(v) = 2 Then
Set s = ActiveSheet.Shapes.AddShape(msoShapeRectangle, ileft, itop, lg, ht)
s.Fill.ForeColor.RGB = impgreen
s.TextFrame.Characters.Text = r.Offset(, 1)
itop = itop + 75
ElseIf r = vbNullString Then
Set s = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, ileft + 2 * ind, itop + ht, lg - ind, 30)
s.Line.Visible = msoFalse
s.Fill.Transparency = 1
With s.TextFrame.Characters
.Font.Name = "Arial"
.Text = r.Offset(, 1).Value
End With
itop = itop + 75
End If
Next r
End Sub