Untested here :
'1. Open the VBA editor in PowerPoint:
'Press Alt + F11 in PowerPoint.
'Go to Insert > Module.
'Copy and paste the following code:
Sub CycleThroughImages()
Dim pptSlide As Slide
Dim pptShape As Shape
Dim excelApp As Object
Dim excelWorkbook As Object
Dim sheet As Object
Dim lastRow As Long
Dim rowIndex As Long
Dim photoPath As String
' Initialize Excel
Set excelApp = CreateObject("Excel.Application")
excelApp.Visible = False ' Keep Excel hidden
Set excelWorkbook = excelApp.Workbooks.Open("C:\Path\To\Your\Spreadsheet.xlsx") ' Update with your spreadsheet path
Set sheet = excelWorkbook.Sheets(1)
' Determine the last row with data in the spreadsheet
lastRow = sheet.Cells(sheet.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
' Get the current slide
Set pptSlide = ActivePresentation.Slides(1) ' Change to the correct slide number
' Loop through each row in the spreadsheet
For rowIndex = 2 To lastRow
' Get the data from the spreadsheet
photoPath = sheet.Cells(rowIndex, 4).Value ' Column 4 = Location
Dim imageName As String
Dim subjectName As String
Dim captionText As String
imageName = sheet.Cells(rowIndex, 1).Value ' Column 1 = Image Name
subjectName = sheet.Cells(rowIndex, 2).Value ' Column 2 = Subject Name
captionText = sheet.Cells(rowIndex, 3).Value ' Column 3 = Caption
' Update the "Photo" shape with the image
For Each pptShape In pptSlide.Shapes
If pptShape.Name = "Photo" Then
' Delete the current picture
pptShape.Delete
' Add the new picture
Set pptShape = pptSlide.Shapes.AddPicture(photoPath, _
MsoTriState.msoFalse, MsoTriState.msoCTrue, _
pptShape.Left, pptShape.Top, pptShape.Width, pptShape.Height)
pptShape.Name = "Photo"
Exit For
End If
Next pptShape
' Update the text shapes
For Each pptShape In pptSlide.Shapes
Select Case pptShape.Name
Case "Image Name"
pptShape.TextFrame.TextRange.Text = imageName
Case "Subject Name"
pptShape.TextFrame.TextRange.Text = subjectName
Case "Caption"
pptShape.TextFrame.TextRange.Text = captionText
End Select
Next pptShape
' Wait for 30 seconds before moving to the next image
Application.Wait Now + TimeValue("00:00:30")
Next rowIndex
' Close the Excel workbook and release resources
excelWorkbook.Close False
excelApp.Quit
Set excelWorkbook = Nothing
Set excelApp = Nothing
MsgBox "Finished cycling through images.", vbInformation
End Sub
To Run the Macro:
Save your PowerPoint file as a macro-enabled presentation (.pptm).
Press Alt + F8, select CycleThroughImages, and click Run.
Ensure the PowerPoint presentation remains open during the execution.
Notes:
Replace "C:\Path\To\Your\Spreadsheet.xlsx" with the full path to your Excel file.
The macro assumes your spreadsheet has a header row, and data starts in row 2.
Ensure the shape names in PowerPoint match exactly ("Photo", "Image Name", etc.).
If you need the process to run indefinitely, modify the loop to restart after the last row.
Bookmarks