VBA PowerPoint Write to Excel on Slide Change in Slideshow - vba

Question

I am attempting to log (1. what slide and 2. the time) to a spreadsheet each time a slide is viewed in presentation mode. I don't want to have the spreadsheet open when I do this and I want it to save automatically. I've been screwing around with it for a few hours now, and I've had varying success. I can't seem to get it to work as intended.
Here's the code I've crammed together so far:
Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim strSheet As String
Dim strPath As String
Dim curentSlide As Integer
Dim timez As Date
Dim z As Integer
strSheet = "test.xlsx"
strPath = "C:\PPToutput\"
strSheet = strPath & strSheet
Dim counter As Integer
counter = 0
counter = counter + 1
currentslide = ActivePresentation.SlideShowWindow.View.Slide.SlideIndex
timez = Now()
If Not IsNull(appExcel) And counter < 2 Then
Set appExcel = CreateObject("Excel.Application")
appExcel.Application.DisplayAlerts = False
appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
wks.Activate
End If
appExcel.Application.Visible = True
Range("A" & Rows.Count).End(xlUp).Offset(1).Value = "Slide " & currentslide
Range("B" & Rows.Count).End(xlUp).Offset(1).Value = timez
wks.Columns.AutoFit
wkb.SaveAs
Set appExcel = Nothing
appExcel.Workbooks.Close
appExcel.Quit
Set appExcel = Nothing
End Sub

Answer 1

I haven't tried the code out, but something I noticed is that this line:
appExcel.Application.Visible = False
comes after the excel program does stuff. I would imagine the workbook opening would be visible because that happens before this line.
Also, I don't see where you're telling the OnSlideShowPageChange sub anything about the workbook you created in the SlideShowBegin sub. You're telling it to do something with a range, which is not the one you declared earlier. So, it thinks you're talking about some range in the powerpoint. Do powerpoints even have ranges?
The other mistake is that you set all of your public declarations to nothing. Once you try to call them again, you're calling nothing. It's still a good idea to do that in your error handler, but not as a normal part of the process.
Look at the [untested] changes I made and see if they make sense:
Public appExcel As Excel.Application
Public wkb As Excel.Workbook
Public wks As Excel.Worksheet
Public rng As Excel.Range
Public strSheet As String
Public strPath As String
Public intRowCounter As Integer
Public intColumnCounter As Integer
Public itm As Object
Sub SlideShowBegin()
On Error GoTo ErrHandler
strSheet = "test.xlsx"
strPath = "C:\PPToutput\"
strSheet = strPath & strSheet
Debug.Print strSheet
'Select export folder
Dim curentSlide As Integer
Dim timez As Date
Dim z As Integer
Dim placeholder1 As String
Dim placeholder2 As String
currentslide = ActivePresentation.SlideShowWindow.View.Slide.SlideIndex
timez = Now()
Set appExcel = CreateObject("Excel.Application")
appExcel.Application.Visible = False
appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
wks.Activate
wks.Range("A1").Value = "Current Slide"
wks.Range("B1").Value = "Time"
Exit Sub
ErrHandler:
If Err.Number = 1004 Then
MsgBox strSheet & " doesn't exist", vbOKOnly, _
"Error"
Else
MsgBox Err.Number & "; Description: ", vbOKOnly, _
"Error"
End If
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing
End Sub
Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
Dim curentSlide As Integer
Dim timez As Date
Dim z As Integer
Dim placeholder1 As String
Dim placeholder2 As String
currentslide = ActivePresentation.SlideShowWindow.View.Slide.SlideIndex
timez = Now()
wks.Range("A" & Rows.Count).End(xlUp).Offset(1).Value = "Slide " & currentslide
wks.Range("B" & Rows.Count).End(xlUp).Offset(1).Value = timez
wks.Columns.AutoFit
wkb.Save
If SSW.View.CurrentShowPosition = _
SSW.Presentation.SlideShowSettings.EndingSlide Then
wkb.Save
wkb.Close
End If
End Sub
Sub SlideShowEnd()
wkb.Save
wkb.Close
End Sub

Answer 2

I rearranged your code a bit so that the initialization only occurs once during the slide show. I added another procedure to close Excel once the slide show has ended.
Private appExcel As Excel.Application
Private wkb As Excel.Workbook
Private wks As Excel.Worksheet
Private counter As Integer
Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
' initialization
Dim strSheet As String
Dim strPath As String
strSheet = "test.xlsx"
strPath = "C:\PPToutput\"
strSheet = strPath & strSheet
Debug.Print strSheet, appExcel Is Nothing
If appExcel Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
appExcel.Application.DisplayAlerts = False
appExcel.WindowState = xlMinimized
appExcel.Visible = True
Set wkb = appExcel.Workbooks.Open(strSheet)
Set wks = wkb.Sheets(1)
counter = wks.UsedRange.Rows.Count - 1
End If
' make log entry
Dim currentSlide As Integer
currentSlide = ActivePresentation.SlideShowWindow.View.Slide.SlideIndex
counter = counter + 1
wks.Range("A" & counter).Value = "Slide " & currentSlide
wks.Range("B" & counter).Value = Now()
End Sub
Sub OnSlideShowTerminate(ByVal Wn As SlideShowWindow)
If Not appExcel Is Nothing Then
wks.Columns.AutoFit
appExcel.WindowState = xlNormal
wkb.Close True
appExcel.Quit
End If
Set appExcel = Nothing
End Sub
If it were my code, I'd also factor out the initialization code and put it in its own procedure so that the OnSlideShowPageChange procedure focused on the logging of the slide changes.