Option Explicit
Dim b As Boolean

...

Sub Obj1ToObj2_1(Obj1, Obj2, Optional Steps = 20)
  Const dt# = 0.02
  Dim x1#, x2#, y1#, y2#, x#, y#, t!
  Dim l1#, t1#, w1#, h1#, l2#, t2#, w2#, h2#
  Do: t = Timer: Do: DoEvents: Loop While Timer < t + dt: Loop While b
  With Obj1
    l1 = .Left: t1 = .Top: w1 = .Width: h1 = .Height
  End With
  l2 = Obj2(1, 1): t2 = Obj2(1, 2)
'  With Obj2
'    l2 = .Left: t2 = .Top: w2 = .Width: h2 = .Height
'  End With
  x1 = l1 + w1 / 2
  y1 = t1 + h1 / 2
  x2 = l2 ' + w2 / 2
  y2 = t2 ' + h2 / 2
  With Obj1
    For x = x1 To x2 Step (x2 - x1) / Steps
      y = (x2 * y1 - x1 * y2 - (y1 - y2) * x) / (x2 - x1)
      .Left = x - w1 / 2
      .Top = y - h1 / 2
      t = Timer + dt
      While Timer < t:  Wend
      DoEvents:
    Next
    x = x2: y = y2: .Left = x - w1 / 2: .Top = y - h1 / 2
  End With
  b = True
End Sub
Sub test()
    Dim lr&, i&, sTmp$
    On Error Resume goto err
    With Evaluate(Application.Caller)
        sTmp$ = .OnAction
        .OnAction = "toggle"
        With Лист1
            lr = .Cells(Rows.Count, "n").End(xlUp).Row
            For i = 6 To lr
                Obj1ToObj2_1 .Shapes("Oval 1"), .Cells(i, "n").Resize(, 2).Value
            Next i
        End With
err:    .OnAction = sTmp
    End With
    MsgBox "Конец"
End Sub
Private Sub toggle()
    b = Not b
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Evaluate("Кнопка 5").OnAction = "test"
End Sub

Evaluate("Кнопка 5").OnAction = "test"