0

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

请注意，此处的解决方法如何刷新幻灯片放映中的活动幻灯片？导致我上面提到的问题（如果单击鼠标，.AddShape、GotoSlide 和增加 slideshowwindow 都会使程序崩溃）

我已经尝试使用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，并且用户可以使用 WASD 键盘输入来控制形状 a。

!!代码运行时注意不要点击幻灯片，否则程序会崩溃！！

4

0 回答 0