我在 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