Using a loop to run through Adding Freeform Nodes

[p_teale]

Hi everyone,

I'm trying to create a freeform shape based on a set of x, y coordinates in cells ranging from D3:E110, though the range will change each time so needs to be dynamic. The bit that I'm struggling with right now is the syntax for the loop - how do I add extra lines that start .AddNodes msoSegmentLine... then add each D and E cell as it increments?

This is where I'm up to so far:



Public Sub GetShape()
Set myDocument = Worksheets(1)
With myDocument.Shapes.BuildFreeform(msoEditingCorner, [D3], [E3])
' while columns in D are not empty, add the next rows to continue plotting the points for the shape
' how do I keep adding lines with the .AddNodes etc for each increment?

Sub LoopUntilBlank()
Dim s As Integer
Application.ScreenUpdating = False
' Set numrows = number of rows of data.
NumRows = Range("D3", Range("D3").End(xlDown)).Rows.Count
' Select cell d3.
Range("D3").Select
' Establish "For" loop to loop "numrows" number of times.
For s = 1 To NumRows
' Append d,e columns to AddNode?

' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select
Next
Application.ScreenUpdating = True
End Sub

.AddNodes msoSegmentLine, msoEditingAuto, 535.3, 437.4
.AddNodes msoSegmentLine, msoEditingAuto, 060.3, 448.3
.AddNodes msoSegmentLine, msoEditingAuto, 585.3, 474.6
.AddNodes msoSegmentLine, msoEditingAuto, 110.3, 518.5
.ConvertToShape
End With
End Sub



Kind regards,

Pete

Using Office365

[yujin]

Hi, Pete.

How do you like this code?


Sub GetShape()
Dim myDocument As Worksheet
Dim s As Integer
Dim NumRows As Long
Dim rng As Range

Set myDocument = Worksheets(1)
Set rng = myDocument.Range("D3").CurrentRegion
NumRows = rng.Rows.Count

With myDocument.Shapes.BuildFreeform(msoEditingCorner, [D3], [E3])
For s = 1 To NumRows
.AddNodes msoSegmentLine, msoEditingAuto, rng.Cells(s, 1), rng.Cells(s, 2)
Next s
.ConvertToShape
End With
End Sub