Option Explicit
  Private shp As Shape, sh As Shape, s$, k#, a#, x#, y#, ok As Boolean, x1#, x2#, y1#, y2#


Sub Линия1()
  'Dim shp As Shape, sh As Shape, s$, k#, a#, x#, y#, ok As Boolean, x1#, x2#, y1#, y2#
  s = Empty
  Range("P5:P33").ClearContents
Dim i&
  
  x1 = Range("L4"): y1 = Range("M4")
  x2 = Range("L5"): y2 = Range("M5")
  k = (y2 - y1) / (x2 - x1):  a = y1 - k * x1
  Set shp = ActiveSheet.Shapes.AddLine(x1, y1, x2, y2)
  shp.Line.EndArrowheadStyle = msoArrowheadTriangle
  shp.Line.Weight = 2
  shp.Line.ForeColor.RGB = RGB(255, 0, 0)
  For Each sh In ActiveSheet.Shapes
    If sh.Name <> shp.Name Then
      x = sh.Left:  y = k * x + a:  ok = IsBetween(y, sh.Top, sh.Top + sh.Height)
      If Not ok Then x = sh.Left + sh.Width: y = k * x + a: ok = IsBetween(y, sh.Top, sh.Top + sh.Height)
      If Not ok Then y = sh.Top:  x = (a - y) / k: ok = IsBetween(x, sh.Left, sh.Left + sh.Width)
      If Not ok Then y = sh.Top + sh.Height: x = (a - y) / k: ok = IsBetween(x, sh.Left, sh.Left + sh.Width)
      If ok Then s = s & vbLf & sh.Name
   
        
    End If
    Next
  'MsgBox shp.Name & " intersect next:" & vbLf & s, , "Look at this"
  'Range("P5:P10").Value = Application.Transpose(s)
  'Debug.Print s

  Range("P5:P20").Value = Application.Transpose(Split(Mid(s, 2), vbLf))
  Range("P5:P20").Replace "#N/A", ""
       Application.OnTime DateAdd("s", 3, Now), "Delete1"

     
     
End Sub


Function IsBetween(x#, x1#, x2#)
  IsBetween = x >= x1 And x <= x2
End Function

Sub Delete1()
    shp.Delete
    Range("P5:P33").ClearContents
    ActiveSheet.Calculate
End Sub