Sub Макрос1()
    Dim o1 As Shape, o2 As Shape
    Dim x1!, y1!, r1!, x2!, y2!, r2!, xa!, ya!, xb!, yb!
    Dim col As Range
    For Each col In [A3:E6].Columns
        On Error Resume Next
        Set o1 = ActiveSheet.Shapes(col.Cells(1))
        Set o2 = ActiveSheet.Shapes(col.Cells(4))
        If Not (o1 Is Nothing Or o2 Is Nothing) Then
            GetParam o1, x1, y1, r1
            GetParam o2, x2, y2, r2
            Dim i&, j&, p#, l!, lmin!
            Dim x1t!, y1t!, x2t!, y2t!, bc&, ec&
            p = Atn(1)
            lmin = [a65536].Top - [a1].Top
            For i = 0 To 7
                x1t = x1 + Cos(p * i) * r1
                y1t = y1 - Sin(p * i) * r1
                For j = 0 To 7
                    x2t = x2 + Cos(p * j) * r2
                    y2t = y2 - Sin(p * j) * r2
                    l = Sqr((x1t - x2t) ^ 2 + (y1t - y2t) ^ 2)
                    If l < lmin Then
                        lmin = l
                        xa = x1t
                        ya = y1t
                        xb = x2t
                        yb = y2t
                        bc = i
                        ec = j
                    End If
                Next
            Next
            With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, xa, ya, xb, yb)
                .ConnectorFormat.BeginConnect o1, (bc + 6) Mod 8 + 1
                .ConnectorFormat.EndConnect o2, (ec + 6) Mod 8 + 1
                .Name = col.Cells(1) & "|" & col.Cells(4)
            End With
        End If
    Next
End Sub