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