让Excel工作表中的形状动起来

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '等待时间（毫秒）
Sub Move_Square()
 Dim centerLeft As Long
 Dim centerTop As Long
 Dim Radius As Double
 Dim Theta As Double
 
 centerLeft = 300
 centerTop = 300
 Radius = 100
 
 With ActiveSheet.Shapes(1)
   For Theta = 0 To 2 * Application.Pi() Step Application.Pi() / 48
     .Left = centerLeft + (Radius * Cos(Theta))
     .Top = centerTop + (Radius * Sin(Theta))
     Sleep 40
     DoEvents
   Next Theta
 End With
End Sub

Sub test()
 Sheet1.Shapes("Rectangle 1").Left = 300
 Sheet1.Shapes("Rectangle 1").Top = 200
 MoveShape Sheet1.Shapes("Rectangle 1"), 0!, 0!, #12:00:01 AM#
End Sub

Sub MoveShape(shp As Shape, ByVal fLeft As Single, ByVal fTop As Single, t As Date)
 ' 将指定的形状从它所在的位置移动到它经过间隔t的位置
 Const d2R = 1.74532925199433E-02
 Const n1   As Long = 20 ' 加速/减速步数
 Const n2   As Long = 20
 Const n    As Long = 2 * n1 + n2 '  总步数
 
 Dim fcv    As Single ' 滑行速度，像素/步
 Dim i      As Long
 Dim v      As Single ' 给定步数的速度
 
 Dim fNumLeft As Single ' 左侧插值分数分子
 Dim fNumTop As Single ' 顶部插值分数分子
 Dim fDen   As Single ' 插值分数分母
 Dim fLeftold As Single ' 原始左侧位置
 Dim fTopOld As Single ' 原始顶部位置
 
 fcv = 1 / (n - n1)
 
 With shp
   fLeft = fLeft - .Left
   fTop = fTop - .Top
   fLeftold = .Left
   fTopOld = .Top
 
   For i = 1 To n
     Select Case i
       Case 1 To n1
         ' 加速
         v = fcv * (1 + Cos(d2R * 180 * (1 + i / n1))) / 2
       Case n1 + 1 To n - n1
         ' 恒速
         v = fcv
       Case Else
         ' 减速
         v = fcv * (1 + Cos(d2R * 180 * (1 + (n - i) / n1))) / 2
     End Select
 
     Debug.Print Right("  " & i, 3) & _
       Format(v, "  0.00000") & _
       Format(.Left, "  ##0.0")
 
     .Left = .Left + v * (fLeft - fNumLeft) / (1 - fDen)
     .Top = .Top + v * (fTop - fNumTop) / (1 - fDen)
     fDen = fDen + v
     fNumLeft = .Left - fLeftold
     fNumTop = .Top - fTopOld
     DoEvents
     Sleep t * 86400000# / n
   Next i
 End With
End Sub