右方向限定ならましになりました。

原因の一部は特定できました。解決法が全くみつかりません(´▽`) '`,、'`,、

根本的にさらにきちっと考える必要があるでしょうね。まだあきらめません

途中ですが，イメージをわかせるために，授業で演示するのには，まぁこれで雰囲気はつたわるかなぁという動きをしました。

前のは吹っ飛んでましたから・・　あれじゃあだめなので，改善はしました。

コードを見ればそのごり押し加減に苦笑をいただけること間違いなしの内容です。(ノД`)・゜・。

コードの前に原因を提示します。

めりこみや斜面対策に角度を９０°回転させているんですが，同じ方向に回転しているせいです。角度によって逆にすることも試してみましたが，そうすると，谷を越えたところでうまくいきませんでした。

まだまったく解決方法は想像できていません。

あと，一応まじめに考えた自己主張をせっかく書いていたので貼ります。解決は結びつきませんでしたけど（ΦωΦ）

コマッタモンダ。

標準モジュール

Option Explicit
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
Public Const Rate As Currency = 1
Const SID = 1
Const PI = 3.1415
Dim blnStop As Boolean

Sub Test()
    Dim TSlide As Slide: Set TSlide = ActivePresentation.Slides(SID)
    Dim shpBall As Shape
    Dim shpSlope As Shape: Set shpSlope = TSlide.Shapes("slope")
    blnStop = False
    ActivePresentation.SlideShowSettings.Run
    
    Dim y0 As Long: y0 = 30
    
    Set shpBall = TSlide.Shapes.AddShape(msoShapeOval, 50, 50, 40, 40)
    shpBall.Fill.ForeColor.RGB = vbYellow
    shpBall.Line.ForeColor.RGB = vbBlack
    shpBall.Line.Weight = 2
    
    Dim Ball As ShpCls: Set Ball = New ShpCls
    Ball.SetShp shpBall
    Dim A0 As Currency: A0 = 1
    Dim AAngle0 As Currency: AAngle0 = PI / 2
    Ball.SetA A0, AAngle0
    Dim Check As CorrCls: Set Check = New CorrCls
    
    Do
        Check.当たり判定 Ball, shpSlope, True, A0, AAngle0
        Ball.Move
        shpBall.TextFrame.TextRange = " "
        DoEvents
        If blnStop = True Then Exit Do
        Sleep 10

        If Ball.X > 960 Then Exit Do
        If Ball.Y > 540 Then Exit Do
         
    Loop
    
    Ball.Delete
End Sub

Sub Draw(pSlide As Slide, 直径 As Long, 色 As Long, pX As Long, pY As Long)
    shpBall = pSlide.Shapes.AddShape(msoShapeOval, pX, pY, 直径, 直径)
    shpBall.Fill.ForeColor.RGB = 色
    shpBall.Line.ForeColor.RGB = RGB(0, 0, 0)
    shpBall.Line.Weight = 2
End Sub

Sub STOPMacro()
    blnStop = True
End Sub


Function Angle(X As Currency, Y As Currency)
    Dim pHosei As Currency
    If Abs(X) < 0.001 Then
        If Y > 0 Then
            Angle = PI / 2
        ElseIf Y < 0 Then
            Angle = -PI / 2
        Else
            Angle = PI / 2 '(;´▽｀A``
        End If
    Else
        If X > 0 Then
            If Y >= 0 Then pHosei = 0 Else pHosei = 2 * PI
        Else
            If Y >= 0 Then pHosei = PI Else pHosei = PI
        End If
        Angle = Atn(Y / X)
    End If
    Angle = Angle + pHosei
End Function

CorrCls.cls

Option Explicit
Const PI As Currency = 3.1415
Private pAngle As Currency
Private pAngleCol As Currency
Private pDist As Currency
Private pDistCol As Currency
Private pDistAngle As Currency
Private pblnColl As Boolean
Property Get bln当たり() As Boolean
    bln当たり = pblnColl
End Property
Property Get 角度() As Currency
    角度 = pAngle
End Property

Property Get 距離() As Currency
    距離 = pDist
End Property

Property Get 重なり距離() As Currency
    重なり距離 = pDistCol
End Property

Public Sub 当たり判定(pShpCls As ShpCls, tShp As Shape, blnMove As Boolean, pA0 As Currency, pAAngle0 As Currency)
    Dim pSlide As Slide: Set pSlide = pShpCls.スライド
    Dim lngShpNo As Long: lngShpNo = pSlide.Shapes.Count
    
    pSlide.Shapes.Range(Array(pShpCls.Shp.Name, tShp.Name)).Duplicate.MergeShapes msoMergeIntersect

    Dim sS As ShpCls: Set sS = pShpCls
    Dim tS As ShpCls: Set tS = New ShpCls: tS.SetShp tShp
    
    pAngle = Angle(tS.X - sS.X, tS.Y - sS.Y)
    pDist = Sqr((tS.X - sS.X) ^ 2 + (tS.Y - sS.Y) ^ 2)

    If pSlide.Shapes.Count = lngShpNo Then
        pShpCls.SetA pA0, pAAngle0
        pblnColl = False
        
        Exit Sub
    End If
    
    pblnColl = True
    Dim dS As ShpCls: Set dS = New ShpCls: dS.SetShp pSlide.Shapes(pSlide.Shapes.Count)
    dS.X = dS.X - 12: dS.Y = dS.Y - 12 'Duplicateのずれの訂正
        

    pDistCol = Sqr((dS.X - sS.X) ^ 2 + (dS.Y - sS.Y) ^ 2)
    pDistAngle = Angle(dS.X - sS.X, dS.Y - sS.Y)
    
        sS.SetV sS.速度大きさ, pDistAngle - PI / 2
    
    If pDistAngle >= PI / 2 Then
        sS.SetA pA0 * Cos(pAAngle0 - PI + pDistAngle), pAAngle0 - PI + pDistAngle
    Else
        sS.SetA pA0 * Cos(pDistAngle) * 1.8, pAAngle0 + pDistAngle
    End If
    Debug.Print sS.速度大きさ; " "; sS.速度角度; " "; sS.加速度大きさ; " "; sS.加速度角度 / 3.16 * 180
    With pSlide.Shapes.AddLine(sS.X, sS.Y, sS.X + sS.速度大きさ * Cos(pDistAngle - PI / 2), sS.Y + sS.速度大きさ * Sin(pDistAngle - PI / 2))
        .Line.ForeColor.RGB = vbRed
        .Line.EndArrowheadStyle = msoArrowheadTriangle
    End With
    
    If blnMove = True Then
        sS.X = sS.X + (sS.Width / 2 - pDistCol) * Cos(pDistAngle + PI)
        sS.Y = sS.Y + (sS.Width / 2 - pDistCol) * Sin(pDistAngle + PI)
    End If

    dS.Delete
End Sub

Function Angle(X As Currency, Y As Currency)
    Dim pHosei As Currency
    If Abs(X) < 0.01 Then
        If Y > 0 Then
            Angle = PI / 2
        ElseIf Y < 0 Then
            Angle = -PI / 2
        Else
            Angle = 0 '(;´▽｀A``
        End If
    Else
        If X > 0 Then
            If Y >= 0 Then pHosei = 0 Else pHosei = 2 * PI
        Else
            If Y >= 0 Then pHosei = PI Else pHosei = PI
        End If
        Angle = Atn(Y / X)
    End If
    Angle = Angle + pHosei
End Function

ShpCls.cls

Option Explicit
Const PI = 3.1415
Private pShp As Shape
Private pV As Currency
Private pVAngle As Currency
Private pA As Currency
Private pAAngle As Currency

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

Property Get Shp() As Shape
    Set Shp = pShp
End Property

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
Property Get Width() As Currency
    Width = pShp.Width
End Property
Property Let Width(pWidth As Currency)
    pShp.Width = pWidth
End Property

Property Get Height() As Currency
    Height = pShp.Height
End Property
Property Let Height(pHeight As Currency)
    pShp.Height = pHeight
End Property
Public Sub Delete()
    pShp.Delete
End Sub

Property Get 速度角度() As Currency
    速度角度 = pVAngle
End Property
Property Get 速度大きさ() As Currency
    速度大きさ = pV
End Property
Property Get 加速度角度() As Currency
    加速度角度 = pAAngle
End Property
Property Get 加速度大きさ() As Currency
    加速度大きさ = pA
End Property

Property Get スライド() As Slide
    Set スライド = ActivePresentation.Slides(pShp.Parent.SlideIndex)
End Property
Public Sub SetV(速度 As Currency, 速度角度 As Currency)
    pV = 速度
    pVAngle = 速度角度
End Sub

Public Sub SetA(加速度 As Currency, 加速度角度 As Currency)
    pA = 加速度
    pAAngle = 加速度角度
End Sub

Public Sub Move()
    Me.X = Me.X + pV * Cos(pVAngle)
    Me.Y = Me.Y + pV * Sin(pVAngle)
    
    pV = Sqr((pV * Cos(pVAngle) + pA * Cos(pAAngle)) ^ 2 + (pV * Sin(pVAngle) + pA * Sin(pAAngle)) ^ 2)
    pVAngle = Angle(pV * Cos(pVAngle) + pA * Cos(pAAngle), pV * Sin(pVAngle) + pA * Sin(pAAngle))
'    Debug.Print pV; " "; pVAngle / 3.14 * 180; " "; pA; " "; pAAngle / 3.14 * 180
'    Stop
End Sub

Function Angle(X As Currency, Y As Currency)
    Dim pHosei As Currency
    If Abs(X) < 0.001 Then
        If Y > 0 Then
            Angle = PI / 2
        ElseIf Y < 0 Then
            Angle = -PI / 2
        Else
            Angle = PI / 2 '(;´▽｀A``
        End If
    Else
        If X > 0 Then
            If Y >= 0 Then pHosei = 0 Else pHosei = 2 * PI
        Else
            If Y >= 0 Then pHosei = PI Else pHosei = PI
        End If
        Angle = Atn(Y / X)
    End If
    Angle = Angle + pHosei
End Function