0

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

在我第一次运行 PowerPoint 时，它可以按照我的意愿工作。但是，如果我不关闭 PowerPoint 并重新启动程序，第二次通过它将不会执行任何操作。该代码一直有效，直到“ActiveSheet”或“ActiveCell”的第一个实例。一旦它到达那行代码，代码就会停止运行。它不会停止幻灯片放映，但不会记录任何数据。

似乎 PowerPoint 以某种方式丢失了与 Excel 的链接。

什么会导致它在“ActiveSheet”或“ActiveCell”上失败？

定时器代码

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
4

0 回答 0