Importing Excel data into PowerPoint slides - Run-time error '-2147024809 (80070057)': The specified value is out of range

Question

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:\Users\Me\File.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:\Users\IngeSchenk\Boer & Croon Management BV\Management Solutions - Bank\Macro Referenties.xlsm")
Set OWB = Excel.Application.Workbooks.Open("C:\Users\IngeSchenk\Dropbox\Test2.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

Answer 1

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:\user\me\File.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