' VBA(PowerPoint2000)

Function IsNear(Point1 As Variant, Point2 As Variant) As Boolean
    IsNear = False
    If Abs(Point1(1, 1) - Point2(1, 1)) < 20# Then
        If Abs(Point1(1, 2) - Point2(1, 2)) < 20# Then
            IsNear = True
        End If
    End If
End Function
Function IndexOfNearPoint(Node As ShapeNodes, Point As Variant) As Integer
    If IsNear(Node(1).Points, Point) Then
        IndexOfNearPoint = 1
    ElseIf IsNear(Node(Node.count).Points, Point) Then
        IndexOfNearPoint = Node.count
    Else
        IndexOfNearPoint = 0
    End If
End Function
Sub ConnectFreeform()
'
' Connection Lines (Wrote with FreeForm AutoShape)
'
    Dim ShapeNames() As String
    Dim ShapeChecked() As Boolean
    Dim i, j As Integer
    Dim count As Integer
    With ActiveWindow.Selection
        count = .ShapeRange.count
        ReDim ShapeChecked(count)
        ReDim ShapeNames(count)
        For i = 1 To count
            ShapeNames(i) = .ShapeRange(i).Name
            ShapeChecked(i) = False
        Next
    End With
    Dim s As ShapeNodes
    Dim stt, last, stp As Integer
    i = 1
    Set s = ActiveWindow.Selection.ShapeRange(ShapeNames(1)).Nodes
    ShapeChecked(1) = True
    j = 1
    stt = 2
    last = s.count
    stp = 1
    With ActiveWindow.Selection.SlideRange.Shapes.BuildFreeform( _
        msoEditingAuto, _
        s(j).Points(1, 1), _
        s(j).Points(1, 2) _
        )
        
        Do While i > 0
            Dim p As Variant
            For j = stt To last Step stp
                p = s(j).Points
                .AddNodes s(j).SegmentType, s(j).EditingType, p(1, 1), p(1, 2)
            Next
            i = 0
            For j = 1 To count
                If Not ShapeChecked(j) Then
                    With ActiveWindow.Selection.ShapeRange(ShapeNames(j))
                        stt = IndexOfNearPoint(.Nodes, p)
                        If stt > 0 Then
                            i = j
                            Set s = .Nodes
                            ShapeChecked(j) = True
                            If stt = 1 Then
                                last = s.count
                                stp = 1
                            Else
                                last = 1
                                stp = -1
                            End If
                            j = count
                        End If
                    End With
                End If
            Next
        Loop
        
        .ConvertToShape.Select
    End With

End Sub