PowerPoint VBA代码在第二次运行时失败而没有重新启动ppt

Question

我在Surface上使用PowerPoint 2013来运行幻灯片演示。在幻灯片放映期间，有一些代码可以跟踪每张幻灯片更改时的时间，并将其记录在单独的Excel文件中。

在我第一次使用PowerPoint时，它的工作方式非常有用。但是，如果我不关闭PowerPoint并重新启动程序，第二次通过它将不会执行任何操作。代码一直有效，直到＆＃34; ActiveSheet＆＃34;或者＆＃34; ActiveCell＆＃34;。一旦到达该行代码，代码就会停止运行。它不会停止播放幻灯片，但它不会记录任何数据。

似乎PowerPoint失去了Excel的链接。

什么会导致它失败＆＃34; ActiveSheet＆＃34;或者＆＃34; ActiveCell＆＃34;？

计时器代码

Dim intSlide As Integer
Dim oExcel As Excel.Application 
Dim oWB As Workbook
Dim WS As Worksheet
Dim strPart As String
Dim strCond As String
Dim intRow As Integer

Public Declare PtrSafe Sub GetSystemTime Lib "kernel32" (lpsystemtime As SYSTEMTIME)
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Type SYSTEMTIME
    Year As Integer
    Month As Integer
    DayOfWeek As Integer
    Day As Integer
    Hour As Integer
    Minute As Integer
    Second As Integer
    Milliseconds As Integer
End Type

每次更改页面时运行的代码

Sub OnSlideShowPageChange(ByVal ssw As SlideShowWindow)
    Dim sTime As SYSTEMTIME
    Dim lngCount As Long
    Dim check
    Dim strFinal As String

    GetSystemTime sTime

    intSlide = 1
    lngCount = 1
    intRow = 1
    strFinal = ""

    intSlide = ssw.View.CurrentShowPosition

    If intSlide = 1 Then
        Set oExcel = New Excel.Application
        Set oWB = oExcel.Workbooks.Open("C:\Users\Ayse Eren\Desktop\TimeSaver.xlsx")
        oExcel.Visible = False
        oExcel.Sheets(1).Activate
        oExcel.Sheets(1).Range("A1").Activate
        strCond = "HUD"
        If oExcel.Sheets(1).Range("A1").Value = "" Then
            oExcel.Sheets(1).Range("A1").Value = "Participant"
            Range("A2").Activate
        Else
            oExcel.Sheets(1).Range("A1").Offset(0, 1).End(xlDown).Offset(1, 0).Activate
            'uses column B (automatically populated) to determine where to start recording data
        End If

        intRow = ActiveCell.Row - 1
    End If

    oExcel.ActiveSheet.Range("A" & (intSlide + intRow)).Activate

    ActiveCell.Offset(0, 1) = strCond
    ActiveCell.Offset(0, 2) = intSlide
    ActiveCell.Offset(0, 3) = sTime.Year
    ActiveCell.Offset(0, 4) = sTime.Month
    ActiveCell.Offset(0, 5) = sTime.Day
    ActiveCell.Offset(0, 6) = sTime.Hour
    ActiveCell.Offset(0, 7) = sTime.Minute
    ActiveCell.Offset(0, 8) = sTime.Second
    ActiveCell.Offset(0, 9) = sTime.Milliseconds

    strFinal = ActivePresentation.Slides(intSlide).Shapes(1).TextFrame.TextRange.Text
    ActiveCell.Offset(0, 12) = strFinal

    If intSlide = 47 Then
        oWB.Save
        oExcel.Visible = True
        oExcel.Quit
    Else
        oWB.Save
    End If

End Sub

如果您在幻灯片47之前退出幻灯片放映，则会运行此代码。

修改

Sub OnSlideShowTerminate(ByVal SSW As SlideShowWindow)
    oWb.Save
    oWb.Close
    oExcel.Visible = True
End Sub