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