How do I move around nodes in a shape? - vba

Question

I am trying to create a Sankey-diagram in Excel, and as a start to this, I am trying to create some "entry arrows" for the left part of the diagram, which will look roughly like this:
I created it by making a chevron arrow, and dragging the rightmost points of it to line up with the tip of the arrow.
Now, to do this for all the arrows I need, I want to do this programmatically, but I can't figure out if there is any way to do much with the nodes (?) of the shape. Trying to record a macro gave me nothing.
This is what I have so far, the macro aborts on the Debug.Print line, probably because the node object doesn't have a Left property :P
Sub energiInn()
Dim r As Range, c As Range
Dim lo As ListObject
Dim topp As Double, høgde As Double
Dim i As Long, farge As Long
Dim nd As Object
Set lo = Tabell.ListObjects("Energi_inn_elektrolyse")
Set r = lo.DataBodyRange
topp = 50
With SankeyDiagram.Shapes
For i = 1 To r.Rows.Count
høgde = Application.WorksheetFunction.Max(10, r.Cells(i, 2) / 50#)
With .AddShape(Type:=msoShapeChevron, Left:=50, top:=topp, Width:=200, Height:=høgde)
.Name = r.Cells(i, 1)
farge = fargekart((i - 1) Mod UBound(fargekart))
.Fill.ForeColor.RGB = RGB(farge Mod 256, (farge \ 256) Mod 256, farge \ 65536)
For Each nd In .Nodes
Debug.Print nd.Left
Next nd
End With
topp = topp + høgde
Next i
End With
Debug.Print r.Address
End Sub
Honestly, I am unsure if this can be done at all, but even if it is impossible, it would be nice to get it confirmed :)

Answer 1

What you're looking for is .Nodes.SetPosition. Because it's relative positioning, this can be a challenge. You need to use the objects position elements to make sure the points are moving in relation to the shape.
With .AddShape(Type:=msoShapeChevron, Left:=50, Top:=topp, Width:=200, Height:=høgde)
.Name = r.Cells(i, 1)
.Nodes.SetPosition 2, .Left + .Width, .Top
.Nodes.SetPosition 4, .Left + .Width, .Top + .Height
First argument is the node index. Next is the x position, which we want all the way to the right of the graphic, so we add the shapes position left to the width of the shape. Last is the y position, first point we want in the topmost corner, so we use the shapes top. Last point, we add the height to the top position to bring to the bottom corner.

Answer 2

I believe it would be more simple drawing this as free form using Shapes.BuildFreeform Method and then converting to shape using FreeformBuilder.ConvertToShape Method.
Example:
Sub drawEntryArrow()
Dim x1 As Single, y1 As Single, w As Single, h As Single
Dim oShape As Shape
x1 = 10
y1 = 10
w = 200
h = 200
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, x1, y1)
.AddNodes msoSegmentLine, msoEditingAuto, x1 + w, y1
.AddNodes msoSegmentLine, msoEditingAuto, x1 + w, y1 + h
.AddNodes msoSegmentLine, msoEditingAuto, x1, y1 + h
.AddNodes msoSegmentLine, msoEditingAuto, x1 + w / 2, y1 + h / 2
.AddNodes msoSegmentLine, msoEditingAuto, x1, y1
Set oShape = .ConvertToShape
End With
End Sub

Answer 3

If you just want to get rid of the point at the right, you can simply delete the node (nodes of a chevron are counted clockwise starting at the top left):
.Nodes.Delete 3
To get access to all nodes with the nodes-property of a shape, however, as long as you deal with a standard shape type, you can't access the coordinates.
When you use the "edit points", a shape changes its type to msoShapeNotPrimitive - but I couldn't figure out how to do this using VBA.
UPDATE
Played around a bit (because I'm curious) - just as an example if someone wants to change a shape manually:
' First change Shape Type:
' WILL NOT WORK: sh.AutoShapeType = msoShapeNotPrimitive
' Instead, add a node and remove it immediately. This changes the shape type.
.Nodes.Insert c, msoSegmentLine, msoEditingCorner, 100, 100
.Nodes.Delete c + 1
' Now access the x-coordinate of node 2 and the y-coordinate of node 3
' (note that we cannot access the coordinates directly)
Dim pointsArray() As Single, x As Single, y As Single
pointsArray = .Nodes(2).Points
x = pointsArray(1, 1)
pointsArray = .Nodes(3).Points
y = pointsArray(1, 2)
' Now change the x-value of node 3
sh.Nodes.SetPosition 3, x, y