There must be a way to refresh the PowerPoint (2016) screen without DoEvents, GotoSlide, or .AddShape

Question

My program constantly updates a shape's position, based on another manipulable shape. Without DoEvents, GotoSlide, .AddShape, or increasing slideshowwindow, the screen will not refresh, and will only show the end result of the shape's position. I can't use DoEvents because it slows down too much when the mouse is moved, and I can't use GotoSlide, .AddShape, or similar methods because they don't allow the user to click in the PowerPoint (will either ignore or crash the program).

Please note, the workarounds here How to refresh the active Slide in a slide show? cause the problems I noted above (.AddShape, GotoSlide, and increasing slideshowwindow all crash the program if the mouse clicks)

I have experimented with GetQueueStaus and GetInputState as a means to filter out certain events from DoEvents, but neither seem to apply. And using them to only DoEvents when necessary obviously isn't an option because it will always be necessary when the shape is moving, and the movement will always slow down based on mouse movement during DoEvents.

Finally, I have also experimented with charts because they are the only shape in PowerPoint that has .refresh functionality, but I both was unable to get this to work, and decided that it wasn't worth the time because the shape of the chart will always be restricted to a rectangle (too limited for what I want my program to do).

Here is my code: (I am currently using GotoSlide method)

Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Sub Aloop()
Dim Q As Shape
Dim B As Shape
Dim TotalTime As Long
Dim StartTime As Long
Dim TimerTextRange As TextRange
Dim A As Shape
Const PI = 3.14159265359

Set A = ActivePresentation.Slides(1).Shapes("A")
Set SldOne = ActivePresentation.Slides(1)
Set Q = ActivePresentation.Slides(1).Shapes("Q")
Set B = ActivePresentation.Slides(1).Shapes("B")
Set TimerTextRange = ActivePresentation.Slides(1).Shapes("TimerTextRange") _
.TextFrame.TextRange



TotalTime = 0
StartTime = Timer
With TimerTextRange
    .Text = Int(TotalTime + (Timer - StartTime))
End With

Do While TimerTextRange.Text < 10
    With TimerTextRange
        .Text = Int(TotalTime + (Timer - StartTime))
    End With

    If Q.Left < A.Left Then
        Q.Left = Q.Left + 1
    ElseIf Q.Left > A.Left Then
        Q.Left = Q.Left - 1
    Else
    End If
    If Q.Top < A.Top Then
        Q.Top = Q.Top + 1
    ElseIf Q.Top > A.Top Then
        Q.Top = Q.Top - 1
    Else
    End If
    If GetAsyncKeyState(vbKeyD) Then
        A.Left = A.Left + 4
    Else
    End If
    If GetAsyncKeyState(vbKeyW) Then
        A.Top = A.Top - 4
    Else
    End If
    If GetAsyncKeyState(vbKeyS) Then
        A.Top = A.Top + 4
    Else
    End If
    If GetAsyncKeyState(vbKeyA) Then
        A.Left = A.Left - 4
    Else
    End If

    With Q
    If (-A.Top + (.Top + .Width / 2)) > 0 Then
        .Rotation = ((Atn(((A.Left + A.Width / 2) - ((.Left + .Width / 2))) / (-(A.Top + A.Height / 2) + ((.Top + .Width / 2))))) * 180 / PI)
    ElseIf (-A.Top + (.Top + .Width / 2)) < 0 Then
        .Rotation = ((Atn(((A.Left + A.Width / 2) - ((.Left + .Width / 2))) / (-(A.Top + A.Height / 2) + ((.Top + .Width / 2))))) * 180 / PI) + 180
    Else
    End If
    End With

    ActivePresentation.SlideShowWindow.View.GotoSlide (1)
Loop




End Sub

The code makes shape Q follow shape A around the screen, and the user can control shape a with W A S D keyboard inputs.

!!Be careful not to click the slide while the code is running, or the program will crash!!