progress through powerpoint with macros not working on second slide

问题

I'm trying to create a macro which will run through slides in a powerpoint presentation. I had it working, but now it has stopped working and I don't know why.

The vbscript to run through the slides and animation are

Private Sub PPTEvent_SlideShowNextBuild(ByVal Wn As SlideShowWindow)
    Sleep 1000
    SendKeys "{RIGHT}"
End Sub


Private Sub PPTEvent_SlideShowNextSlide(ByVal Wn As SlideShowWindow)
    Sleep 1000   
    SendKeys "{RIGHT}"
End Sub

Is there a better way to accomplish this? I can't see where the problem is, I've tried removing Sleep 1000 as well, but no dice.

Strangely, if I use both

SendKeys "{ENTER}"
SendKeys "{RIGHT}"

together, it runs through the entire slideshow as I'd hoped.

回答1:

Here is another way based on the help for SlideShowSettings

There is an error in the MSDN page which I have corrected below (need to use msoTrue/False not True/False for LoopUntilStopped).

It starts automatically when you enter SlideShow mode and the animations run OK.

In a standard Module...

Public showRunning As Boolean

Sub runSlides()

  showRunning = True
  For Each s In ActivePresentation.Slides
    With s.SlideShowTransition
      .AdvanceOnTime = msoTrue
      .AdvanceTime = 1
    End With
  Next

  With ActivePresentation.SlideShowSettings

    .RangeType = ppShowAll
    .AdvanceMode = ppSlideShowUseSlideTimings
    .LoopUntilStopped = msoFalse
    .ShowWithAnimation = msoTrue
    .Run

  End With

End Sub

Public Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)

  If Not showRunning Then
    runSlides
  End If

End Sub

Public Sub OnSlideShowTerminate(ByVal Wn As SlideShowWindow)
  showRunning = False
  closeSlideShow
End Sub

Public Sub closeSlideShow()
Dim s As Slide

  For Each s In ActivePresentation.Slides
    With s.SlideShowTransition
      .AdvanceOnTime = msoFalse
    End With
  Next

  On Error Resume Next
  ActivePresentation.SlideShowWindow.View.Exit
  On Error GoTo 0

End Sub

EDIT:

Added the closeSlideShow routine to stop slideshow running every time.

Note: setting .AdvanceOnTime to msoFalse programatically or manually un-checking Use Timings in the SLIDE SHOW ribbon tab, will stop the slideshow from running. It seems that setting this to msoTrue, having entered with it set to msoFalse, and trying to do ActivePresentation.SlideShowSettings.Run in the same routine will not work!

回答2:

In general, SendKeys should be avoided. Why don't you try something like

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub GoThroughSlides()
    Dim sl As PowerPoint.Slide
    ActivePresentation.SlideShowSettings.Run
    For Each sl In ActivePresentation.Slides
        Sleep 3000 '
        ActivePresentation.SlideShowWindow.Activate
        SlideShowWindows(1).View.GotoSlide sl.SlideNumber
    Next sl
End Sub

来源：https://stackoverflow.com/questions/28247552/progress-through-powerpoint-with-macros-not-working-on-second-slide

标签

vba

powerpoint

powerpoint-vba