In the meanwhile I have tasked GPT to write me a macro:

Export of Slides from PowerPoint into Excel Table

Author: Bodo Heiss
Date: May 2023
Infrastructure: Office 2021, Windows 10, ChatGPT 3.5

With ChatGPT I have created the macro enclosed:

The task I formulated was:
“How can I create an excel table with title, name of presentation and miniature view of slide across all slides and presentations in PowerPoint?

It took about 10 iterations, where I fed back error messages until I finally arrived with a macro that ran without errors.
Only slides in an open PowerPoint presentation will be analysed.

To establish the macro do as follows in PowerPoint and copy the following macro into the editing window:

1. Open your PowerPoint presentation and press ALT + F11 to open the VBA Editor.
2. In the VBA Editor, click on "Insert" and choose "Module" to create a new module.



 
Sub CreateSlideIndex()

Dim PowerPoint As Object
Dim pptPres As Object
Dim pptSlide As Object

Dim Excel As Object
Dim excelApp As Object
Dim excelWb As Object
Dim excelWs As Object

Dim row As Long
Dim col As Long

' Create PowerPoint and Excel instances
Set PowerPoint = CreateObject("PowerPoint.Application")
Set Excel = CreateObject("Excel.Application")

' Open Excel workbook and set worksheet
Set excelWb = Excel.Workbooks.Add()
Set excelWs = excelWb.Worksheets(1)

' Set column headers
excelWs.Cells(1, 1).Value = "Title"
excelWs.Cells(1, 2).Value = "Presentation"
excelWs.Cells(1, 3).Value = "Slide"
excelWs.Cells(1, 4).Value = "Thumbnail"

row = 2 ' Start at row 2 for data

' Loop through each PowerPoint presentation
For Each pptPres In PowerPoint.Presentations

' Loop through each slide in the presentation
For Each pptSlide In pptPres.Slides

' Get slide title
Dim titleText As String
If pptSlide.Shapes.HasTitle Then
titleText = pptSlide.Shapes.Title.TextFrame.TextRange.Text
Else
titleText = "Untitled"
End If

' Add data to Excel worksheet
excelWs.Cells(row, 1).Value = titleText
excelWs.Cells(row, 2).Value = pptPres.Name
excelWs.Cells(row, 3).Value = pptSlide.slideIndex

' Save slide thumbnail to temp folder
pptSlide.Export Environ("TEMP") & "\thumbnail.jpg", "jpg"

' Insert thumbnail into Excel worksheet
Dim bodyShape As Object
Set bodyShape = excelWs.Shapes.AddPicture(Environ("TEMP") & "\thumbnail.jpg", False, True, 0, 0, 75, 50)
With bodyShape
.Left = excelWs.Cells(row, 4).Left
.Top = excelWs.Cells(row, 4).Top
.Placement = 1
End With

row = row + 1 ' Move to next row for next slide

Next pptSlide

Next pptPres

' Auto-fit columns
excelWs.Columns.AutoFit

' Make Excel visible
Excel.Visible = True

' Clean up
Set PowerPoint = Nothing
Set pptPres = Nothing
Set pptSlide = Nothing
Set Excel = Nothing
Set excelApp = Nothing
Set excelWb = Nothing
Set excelWs = Nothing

End Sub