Styjun

I am trying to load data from an Excel rows into PowerPoint slides, but the code breaks on the last line and gives the error

'Value out of range'.

This is the first time that I'm working with VBA so I might be making a really stupid mistake but I can't get it fixed myself.

I am using the script from this site
https://www.craig-tolley.co.uk/2011/06/08/vba-create-powerpoint-slide-for-each-row-in-excel-workbook/

I have tried breaking up the line of code and it seems like the error is caused by the .Textrange.Text part, but this is used in loads of other examples just fine?

Opening the Excel and loading the values WS.Cells(i, 1).Value works, I tried this with Msgbox().

So the error seems to be with selecting and filling the text boxes / shapes (just one in this example). I have added empty text boxes via the developer menu besides the normal text boxes that were already there, and I have renamed them in the Selection Pane.

Can someone tell me what I'm doing wrong?

Sub ReferentieSlides()
 'Open the Excel workbook. Change the filename here.
 Dim OWB As New Excel.Workbook
 Set OWB = Excel.Application.Workbooks.Open("C:UsersMeFile.xlsm")

 'Grab the first Worksheet in the Workbook
 Dim WS As Excel.Worksheet
 Set WS = OWB.Worksheets(1)

 'Loop through each used row in Column A
 For i = 1 To WS.Range("A10").End(xlUp).Row
 'Copy the first slide and paste at the end of the presentation
 ActivePresentation.Slides(1).Copy
 ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1)
 'Change the text of the first text box on the slide.
 ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = WS.Cells(i, 1).Value 
 Next
End Sub

Code with fixes tried so far:

#If VBA7 Then
 Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
 Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If

Sub ReferentieSlides()


'Open the Excel workbook. Change the filename here.
Dim OWB As New Excel.Workbook
'Set OWB = Excel.Application.Workbooks.Open("C:UsersIngeSchenkBoer & Croon Management BVManagement Solutions - BankMacro Referenties.xlsm")
Set OWB = Excel.Application.Workbooks.Open("C:UsersIngeSchenkDropboxTest2.xlsx")

'Grab the first Worksheet in the Workbook
Dim WS As Excel.Worksheet
Set WS = OWB.Worksheets(1)

'Define i
Dim i As Long

'Loop through each used row in Column A
For i = 1 To WS.Range("A" & Rows.Count).End(xlUp).Row
'Copy the first slide and paste at the end of the presentation
 ActivePresentation.Slides(1).Copy
 ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1)

 'Sleep for 10sec
 MsgBox "Execution is started"
 Sleep 10000 'delay in milliseconds
 MsgBox "Execution Resumed"

 'Change the text of the first text box on the slide.
 ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = WS.Cells(i, 1).Value

Next

End Sub

Due to David Zemens comment about this being a PPT macro, I have changed this answer. The problem is using the End(xlup) function that doesn't work in PPT
This did work for me, but the opening excel can be done your way if it works for you.

Sub ReferentieSlides()
 'Open the Excel workbook. Change the filename here.
Dim OWB As Object
 Set OWB = CreateObject("T:usermeFile.xlsm")

 'Grab the first Worksheet in the Workbook
 Set WS = OWB.Sheets(1)


Set PPTObj = ActivePresentation 'Get the presentation that was opened

 'Loop through each used row in Column A
 'For i = 1 To WS.Range("A10").End(xlUp).Row
 For i = 1 To WS.Range("A1:A10").CurrentRegion.Rows.Count
 'Copy the first slide and paste at the end of the presentation
 PPTObj.Slides(1).Copy
 PPTObj.Slides.Paste (PPTObj.Slides.Count + 1)
 'Change the text of the first text box on the slide.
 PPTObj.Slides(PPTObj.Slides.Count).Shapes(1).TextFrame.TextRange.Text = WS.Cells(i, 1).Value
 Next
End Sub