Move Shape with Cursor / Convert this VBA from Excel

[Kellaroo]

Hi All !
Could this code be successfully converted to work in PowerPoint?
It's intended to make a shape smoothly follow the mouse cursor. I've been trying to transcribe it for hours but I'm afraid it's over my head. Any help or alternatives to getting a shape to follow the mouse cursor would be much appreciated. Thank you for your consideration!

'Option Explicit
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Sub MouseMoveObjectTest()
    Dim lngCurPos As POINTAPI
    Dim DocZero As POINTAPI
    Dim PointsPerPixelY As Double
    Dim PointsPerPixelX As Double
    Dim hdc As Long
    
    For Each sp In Worksheets("Sheet1").Shapes
    sp.Delete
    Next
     
    Set a = Worksheets("Sheet1").Shapes.AddShape(92, 50, 50, 20, 20)
    a.Name = "Oval2"
    a.Fill.ForeColor.SchemeColor = False
    
    hdc = GetDC(0)
    PointsPerPixelY = 72 / GetDeviceCaps(hdc, 90)
    PointsPerPixelX = 72 / GetDeviceCaps(hdc, 88)
    ReleaseDC 0, hdc
    
    DocZero.Y = ActiveWindow.PointsToScreenPixelsY(0)
    DocZero.X = ActiveWindow.PointsToScreenPixelsX(0)
    
    Do
     
        GetCursorPos lngCurPos
         
        ' Find the Center of the Stationary and Moving Object
        CenterRowStationary = (lngCurPos.Y - DocZero.Y) * PointsPerPixelY
        CenterColStationary = (lngCurPos.X - DocZero.X) * PointsPerPixelX
        CenterRowMoving = Shapes("Oval2").Top + Shapes("Oval2").Height / 2
        CenterColMoving = Shapes("Oval2").Left + Shapes("Oval2").Width / 2
         
        MovementSpeed = 1.25
        
        ' Now comes the hard part.  I want the object to follow a straight path to the stationary
        ' object, so I will need to use Right Triangle Math to do this.
        ' First, I need to determine the Hypotenus of the Right Triangle give the height and width
        ' of the right triangle
        TriangleHeight = Abs(CenterRowStationary - CenterRowMoving)
        TriangleWidth = Abs(CenterColStationary - CenterColMoving)
        TriangleHyp = Sqr(TriangleHeight ^ 2 + TriangleWidth ^ 2)
        
        ' Ok, now I will need to use the movement speed (which is the hypotenuse of a smaller
        ' right triangle within the larger right triangle above) to determine the height and width
        ' of this new triangle.  These values are directly proportional to the values in the above
        ' triangle.
        If TriangleHeight = 0 Then
            NewTriangleHeight = 0
        Else
            NewTriangleHeight = (TriangleHeight / TriangleHyp) * MovementSpeed
        End If
        
        If TriangleWidth = 0 Then
            NewTriangleWidth = 0
        Else
            NewTriangleWidth = (TriangleWidth / TriangleHyp) * MovementSpeed
        End If
        
        ' These new values are the row and column adjustment factors we will use to move
        ' the object.
        With Shapes("Oval2")
            If (.Top + Shapes("Oval2").Height / 2) > CenterRowStationary Then .Top = .Top - NewTriangleHeight
            If (.Top + Shapes("Oval2").Height / 2) < CenterRowStationary Then .Top = .Top + NewTriangleHeight
            If (.Left + Shapes("Oval2").Width / 2) > CenterColStationary Then .Left = .Left - NewTriangleWidth
            If (.Left + Shapes("Oval2").Width / 2) < CenterColStationary Then .Left = .Left + NewTriangleWidth
        End With
        
        DoEvents
    Loop
End Sub

[georgiboy]

I would not call it smooth but maybe you can play with the settings...

Maybe:

Option Explicit
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Sub MouseMoveObjectTest()
    Dim lngCurPos As POINTAPI
    Dim DocZero As POINTAPI
    Dim PointsPerPixelY As Double
    Dim PointsPerPixelX As Double
    Dim hdc As Long
    Dim sp As Shape, a As Shape
    Dim CenterRowStationary As Double
    Dim CenterColStationary As Double
    Dim CenterRowMoving As Double
    Dim CenterColMoving As Double
    Dim MovementSpeed As Double
    Dim TriangleHeight As Double
    Dim TriangleWidth As Double
    Dim TriangleHyp As Double
    Dim NewTriangleHeight As Double
    Dim NewTriangleWidth As Double
    
    For Each sp In ActivePresentation.Slides(1).Shapes
        sp.Delete
    Next
     
    Set a = ActivePresentation.Slides(1).Shapes.AddShape(92, 50, 50, 20, 20)
    a.Fill.ForeColor.RGB = RGB(0, 75, 150)
    hdc = GetDC(0)
    PointsPerPixelY = 72 / GetDeviceCaps(hdc, 90)
    PointsPerPixelX = 72 / GetDeviceCaps(hdc, 88)
    ReleaseDC 0, hdc
    DocZero.Y = ActiveWindow.PointsToScreenPixelsY(0)
    DocZero.X = ActiveWindow.PointsToScreenPixelsX(0)
    
    Do
        GetCursorPos lngCurPos
        CenterRowStationary = (lngCurPos.Y - DocZero.Y) * PointsPerPixelY
        CenterColStationary = (lngCurPos.X - DocZero.X) * PointsPerPixelX
        CenterRowMoving = a.Top + a.Height / 2
        CenterColMoving = a.Left + a.Width / 2
        MovementSpeed = 1
        TriangleHeight = Abs(CenterRowStationary - CenterRowMoving)
        TriangleWidth = Abs(CenterColStationary - CenterColMoving)
        TriangleHyp = Sqr(TriangleHeight ^ 2 + TriangleWidth ^ 2)
        If TriangleHeight = 0 Then
            NewTriangleHeight = 0
        Else
            NewTriangleHeight = (TriangleHeight / TriangleHyp) * MovementSpeed
        End If
        
        If TriangleWidth = 0 Then
            NewTriangleWidth = 0
        Else
            NewTriangleWidth = (TriangleWidth / TriangleHyp) * MovementSpeed
        End If
        With a
            If (.Top + .Height / 2) > CenterRowStationary Then .Top = .Top - NewTriangleHeight
            If (.Top + .Height / 2) < CenterRowStationary Then .Top = .Top + NewTriangleHeight
            If (.Left + .Width / 2) > CenterColStationary Then .Left = .Left - NewTriangleWidth
            If (.Left + .Width / 2) < CenterColStationary Then .Left = .Left + NewTriangleWidth
        End With
        DoEvents
    Loop
End Sub

[Kellaroo]

You got it to work! Definitely more than I could do, though I see now I was very close in my initial attempt. Thanks for getting it this far : )

Like you said though, it's not very smooth. When I think about the code, it's hard to understand why. Like it shouldn't be too much to process, but it looks so glitchy.
If I ever figure out how to improve it, I'll share here!