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