惑星ぽいのを書きなおしました。

chemiphys.hateblo.jp
これで改善したコードのさらに改善です。

いちおうこれで完結かなと思いますので，もう一度全貌をまとめます。

このような感じの名前の図形たちがコードに書かれているので必要です。
StopButtonというボタンが必要です。StopMacroを関連付けして止めれるようにします。

コードはこちら
GetRとMoveの両側で二つの図形を指定していて，修正等面倒でしたので，thomさんのアドバイスを考慮して

まずParts.SetShpで図形と角速度の係数を設定するように変更。GetRで行っていた処理もここで行う。
Parts.MoveはDo ～ loopの中で。角速度の係数を事前に設定していたので，ここでは引数無しでできるのでFor ～ Nextでやれます。

十分すっきりしたかな～。

Option Explicit
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
Private blnStop As Boolean

Sub 円運動()
ActivePresentation.SlideShowSettings.Run
blnStop = False

Dim TSlide As Slide: Set TSlide = ActivePresentation.Slides(1)
Dim Sun As Shape: Set Sun = TSlide.Shapes("Sun")
Dim Mercury As Shape: Set Mercury = TSlide.Shapes("Mercury")
Dim Venus As Shape: Set Venus = TSlide.Shapes("Venus")
Dim Earth As Shape: Set Earth = TSlide.Shapes("Earth")
Dim Mars As Shape: Set Mars = TSlide.Shapes("Mars")
Dim Moon As Shape: Set Moon = TSlide.Shapes("Moon")
Dim Angle As Currency
Dim p(1 To 5) As Parts
Dim i As Long, j As Long
    
For i = 1 To 5
    Set p(i) = New Parts
Next


p(1).SetShp Mercury, Sun, 4.15
p(2).SetShp Venus, Sun, 1.62
p(3).SetShp Earth, Sun, 1
p(4).SetShp Moon, Earth, 20
p(5).SetShp Mars, Sun, 0.531

Do
    Angle = -j * 3.14 / 180 * 10
    
    For i = 1 To 5
        p(i).Move Angle
    Next
    
    TSlide.Shapes("StopButton").TextFrame.TextRange = "STOP"
    
    DoEvents
    If blnStop = True Then Exit Do
    Sleep 100
    j = j + 1
Loop

Application.SlideShowWindows(1).View.Exit

End Sub

Sub StopMacro()
    If blnStop = False Then blnStop = True
End Sub

Parts.cls

Option Explicit

Private pR As Currency
Private s1 As ShpCls
Private sc As ShpCls
Private pAngleRate As Currency

Public Sub SetShp(pShp1 As Shape, pShpCenter As Shape, 角度係数 As Currency)
    Set s1 = New ShpCls: s1.SetShp pShp1
    Set sc = New ShpCls: sc.SetShp pShpCenter
    pR = Sqr((s1.X - sc.X) ^ 2 + (s1.Y - sc.Y) ^ 2)
    pAngleRate = 角度係数
End Sub

Public Sub Move(pAngle As Currency)
    s1.X = sc.X + pR * Cos(pAngle * pAngleRate)
    s1.Y = sc.Y + pR * Sin(pAngle * pAngleRate)
End Sub

ShpCls.cls

Option Explicit

Private pShp As Shape

Public Sub SetShp(図形 As Shape)
    Set pShp = 図形
End Sub

Property Get X() As Currency
    X = pShp.Left + pShp.Width / 2
End Property
Property Let X(X座標 As Currency)
    pShp.Left = X座標 - pShp.Width / 2
End Property

Property Get Y() As Currency
    Y = pShp.Top + pShp.Height / 2
End Property
Property Let Y(Y座標 As Currency)
    pShp.Top = Y座標 - pShp.Height / 2
End Property

Property Get Left() As Currency
    Left = pShp.Left
End Property
Property Let Left(pLeft As Currency)
    pShp.Left = pLeft
End Property

Property Get Right() As Currency
    Right = pShp.Left + pShp.Width
End Property
Property Let Right(pRight As Currency)
    pShp.Left = pRight - pShp.Width
End Property

Property Get Top() As Currency
    Top = pShp.Top
End Property
Property Let Top(pTop As Currency)
    pShp.Top = pTop
End Property

Property Get Bottom() As Currency
    Bottom = pShp.Top + pShp.Height
End Property
Property Let Bottom(pBottom As Currency)
    pShp.Top = pBottom - pShp.Height
End Property