Question

我的程序会根据另一个可操作的形状不断更新形状的位置。如果没有 DoEvents ， GotoSlide ， .AddShape 或增加幻灯片放映窗口，屏幕将不会刷新，并且只会显示形状位置的最终结果。我无法使用DoEvents，因为鼠标移动时速度过慢，我无法使用GotoSlide，.AddShape或类似方法，因为它们不允许用户点击PowerPoint（将忽略或崩溃程序）。

请注意，此处的解决方法How to refresh the active Slide in a slide show?导致我上面提到的问题（.AddShape，GotoSlide和增加的幻灯片窗口，如果鼠标点击则会使程序崩溃）

我已尝试使用 GetQueueStaus 和 GetInputState 作为从DoEvents中过滤掉某些事件的方法，但似乎都不适用。并且在必要时仅将它们用于DoEvents显然不是一个选项，因为当形状移动时它总是必要的，并且在DoEvents期间移动将总是基于鼠标移动而减慢。

最后，我还尝试了图表，因为它们是PowerPoint中唯一具有.refresh功能的形状，但我都无法使其工作，并且认为它不是＆＃39值得花时间，因为图表的形状总是被限制在一个矩形（对于我希望我的程序来说太有限）。

这是我的代码:(我目前正在使用 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，并且用户可以使用W A S D键盘输入控制形状a。

!!小心不要在代码运行时点击幻灯片，否则程序会崩溃!!

必须有一种方法可以在没有DoEvents，GotoSlide或.AddShape

0 个答案: