Должен быть способ обновления экрана PowerPoint (2016) без DoEvents, GotoSlide или.AddShape.

Question

Моя программа постоянно обновляет позицию фигуры, основываясь на другой манипулируемой фигуре. Без DoEvents, GotoSlide, .AddShape или увеличения слайдшоу окно не будет обновляться и будет отображать только конечный результат положения фигуры. Я не могу использовать DoEvents, потому что он слишком сильно замедляется при перемещении мыши, и я не могу использовать GotoSlide, .AddShape или подобные методы, потому что они не позволяют пользователю нажимать в PowerPoint (будет либо игнорировать, либо сбой программы).

Обратите внимание, что здесь есть способы обхода Как обновить активный слайд в слайд-шоу? вызвать проблемы, которые я отметил выше (.AddShape, GotoSlide, и увеличение слайдшоу, все окна вызывают сбой программы, если щелкнуть мышью)

Я экспериментировал с GetQueueStaus и GetInputState в качестве средства отфильтровать определенные события из DoEvents, но ни один из них, похоже, не применяется. И использовать их только для DoEvents, когда это необходимо, очевидно, не вариант, потому что он всегда будет необходим, когда фигура движется, и движение всегда будет замедляться в зависимости от движения мыши во время DoEvents.

Наконец, я также экспериментировал с диаграммами, потому что они - единственная фигура в PowerPoint, которая имеет функциональность.refresh, но я не смог заставить это работать, и решил, что это не стоит времени, потому что форма диаграммы будет всегда быть ограниченным прямоугольником (слишком ограниченным для того, что я хочу, чтобы моя программа делала).

Вот мой код: (в настоящее время я использую метод GotoSlide)

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

Код заставляет форму Q следовать форме A вокруг экрана, и пользователь может управлять формой A с помощью клавиш ввода W A S D.

Будьте осторожны, чтобы не нажать на слайд во время выполнения кода, иначе программа вылетит!!