VBA slide Delete method was working and has stopped

Question

I have the same problem as highlighted in this question:

Powerpoint VBA - Error when trying to delete slides

My code was working perfectly and then suddenly stopped working. Run-time error '-2147467259 (8000405)' Method 'Delete' of object '_Slide' failed. The code reads data from an Excel spreadsheet and writes it to PowerPoint Slides. It then "Saves As" and then deletes all the created slides in the current presentation to get it back to "base" state. There is also a slide delete in the middle for when a project is complete and the slide is not necessary.

Any help would be appreciated. I have checked that all Add-ins are disabled on the Excel and the PowerPoint side and I have tried saving a copy of the PowerPoint.

Sub CreateSlides()

'Open the Excel workbook. BCC RDTC Implementation.
Dim OWB As New Excel.Workbook
Set OWB = Excel.Application.Workbooks.Open("https://somethinggroup.sharepoint.com/sites/FR_GSI_MEA_Wave2-80-Projet/Shared Documents/80-[Project]/KZ8A&KZ4AT Project/Part 23 PM/Top 3 BCC RDTC/BCC RDTC Implementation.xlsx") 'Grab the first Worksheet in the Workbook
Dim WS As Excel.Worksheet
Set WS = OWB.Worksheets(1)

WS.UnProtect "Password12!"
If (WS.AutoFilterMode And WS.FilterMode) Or WS.FilterMode Then
    WS.ShowAllData
End If

WS.Range("A1:AK60").Sort Key1:=WS.Columns(14), Order1:=xlDescending, Header:=xlYes

WS.Protect Password:="Password12!", AllowFiltering:=True

Dim ReportDate As Date
Dim DateStr As String
ReportDate = Date
DateStr = Format(ReportDate, "dd/mm/yyyy")
DateStrA = Format(ReportDate, "ddmmyyyy")

Dummy = MsgBox("Please wait for the completion message", 0, "Generating")

'Loop through each used row in Column A
For i = 2 To WS.Range("A65").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)
    ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Report Date")).TextFrame.TextRange.Text = DateStr
    ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes("CommandButton1").Delete

    'Get the number of columns in use on the current row
    Dim LastCol As Long
    LastCol = WS.Rows(i).End(xlToRight).Column
    If LastCol = 16384 Then LastCol = 1 'For some reason if only column 1 has data it returns 16384, so correct it
    
    'If the current project is complete delete the slide and move to the next project
    If WS.Cells(i, 35).Value = "Yes" Then
        ActivePresentation.Slides(ActivePresentation.Slides.Count).Delete
        GoTo Skipped
    End If
    
    
    'Write the relevant data to the slide

    For j = 1 To LastCol
        Select Case j
            Case 1
                'Do Nothing
            Case 2
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Project Name")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 3
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Loco")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 4
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("ROA")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 5
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("ROA Date")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 6
                'Do Nothing
            Case 7
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Net Savings")).TextFrame.TextRange.Text = Format(WS.Cells(i, j).Value, "#,###")
            Case 8
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Project Manager")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 9
                'Do Nothing
            Case 10
                'Do Nothing
            Case 11
                'Do Nothing
            Case 12
                'Do Nothing
            Case 13
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Immediacy")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 14
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Urgency")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 15
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Percent Comp")).TextFrame.TextRange.Text = WS.Cells(i, j).Value * 100 & "%"
            Case 16
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 1).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 17
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 2).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 18
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 3).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 19
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 4).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 20
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 5).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 21
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 6).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 22
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 7).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 23
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 8).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 24
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 9).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 25
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 10).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 26
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 11).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 27
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 12).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 28
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 13).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 29
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 14).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 30
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 15).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 31
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 16).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 32
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 17).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 33
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 18).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 34
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 19).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 35
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 20).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 36
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("Current Sup")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 37
                ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("New Sup")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
        End Select
    Next
Skipped:
Next

WS.UnProtect "Password12!"
If (WS.AutoFilterMode And WS.FilterMode) Or WS.FilterMode Then
    WS.ShowAllData
End If

WS.Range("A1:AI60").Sort Key1:=WS.Columns(1), Order1:=xlAscending, Header:=xlYes

WS.Protect Password:="Password12!", AllowFiltering:=True

OWB.Close
Sleep (5000)
    
With ActivePresentation
    .SaveCopyAs "https://somethinggroup.sharepoint.com/sites/FR_GSI_MEA_Wave2-80-Projet/Shared Documents/80-[Project]/KZ8A&KZ4AT Project/Part 23 PM/Top 3 BCC RDTC/Weekly_Reports/Report" & DateStrA & ".pptx", ppSaveAsOpenXMLPresentation
End With

Sleep (10000)
    
For k = ActivePresentation.Slides.Count To 2 Step -1
        ActivePresentation.Slides(k).Delete
Next k

ActivePresentation.SlideShowWindow.View.Exit

Dummy = MsgBox("Report slides have been generated", 0, "Complete")

End Sub

What do you mean by stopped working? Do you get an error, if yes: what error on which row, if no: slide doesn't get deleted, ...??? — Ike
– Ike, Commented Sep 17, 2024 at 11:24
Hello. Thank you. Yes. I get this error messsage: Run-time error '-2147467259 (8000405)' Method 'Delete' of object '_Slide' failed — Adrian J G
– Adrian J G, Commented Sep 17, 2024 at 11:48
Slide index is correct and slide does exist. In the second delete case I work backwards through the presentation and delete all except the first slide. As I said it was working perfectly and then stopped. No change. Only closing the PowerPoint and reopening it. — Adrian J G
– Adrian J G, Commented Sep 17, 2024 at 11:55
Are there multiple presentations open? Could it be that ActivePresentation is not the one you are expecting it to be? — Ike
– Ike, Commented Sep 17, 2024 at 12:03
No only one presentation open. At one point I do a save as but I always have only one presentation open: With ActivePresentation .SaveCopyAs "https://somethinggroup.sharepoint.com/sites/FR_GSI_MEA_Wave2-80-Projet/Shared Documents/80-[Project]/KZ8A&KZ4AT Project/Part 23 PM/Top 3 BCC RDTC/Weekly_Reports/Report" & DateStrA & "_DO_NOT_USE" & ".pptx", ppSaveAsOpenXMLPresentation End With — Adrian J G
– Adrian J G, Commented Sep 17, 2024 at 12:08

Adrian J G · Accepted Answer · 2024-09-20 10:40:24Z

Problem Solved. Two main changes:

I was creating a slide, then checking if it was necessary, if necessary I would populate, if not necessary I would delete. I changed to first check if the slide was necessary and only created if necessary.
I was adding requried slides to the "ActivePresentation" After adding all needed slides, I did a "SaveAs" then I deleted all the added slides from the "ActivePresentation" In the new version I don't add the slides to the ActivePresentation but rather to an output presentation. I then save the output presentation. So there is never a need to delete slides.

So... I didn't actually solve the problem of deleting slides. I just eliminated the need to delete slides.

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)

Sub CreateSlides()

'Open the Excel workbook. BCC RDTC Implementation.
Dim OWB As New Excel.Workbook
Set OWB = Excel.Application.Workbooks.Open("https://Somethinggroup.sharepoint.com/sites/FR_GSI_MEA_Wave2-80-Projet/Shared Documents/80-[Project]/KZ8A&KZ4AT Project/Part 23 PM/Top 3 BCC RDTC/BCC RDTC Implementation.xlsx") 'Grab the first Worksheet in the Workbook
Dim WS As Excel.Worksheet
Dim CurSlideID As Long
Set WS = OWB.Worksheets(1)

WS.UnProtect "Password12!"
If (WS.AutoFilterMode And WS.FilterMode) Or WS.FilterMode Then
    WS.ShowAllData
End If

WS.Range("A1:AK60").Sort Key1:=WS.Columns(14), Order1:=xlDescending, Header:=xlYes

WS.Protect Password:="Password12!", AllowFiltering:=True

Dim ReportDate As Date
Dim DateStr As String
ReportDate = Date
DateStr = Format(ReportDate, "dd/mm/yyyy")
DateStrA = Format(ReportDate, "ddmmyyyy")

Dummy = MsgBox("Please wait for the completion message", 0, "Generating")

'Create the Output Presentation

Set sourcePres = ActivePresentation
Set outputPres = Presentations.Add(True)

'Loop through each used row in Column A
For i = 2 To WS.Range("A65").End(xlUp).Row
    
    'If the current project is complete then skip slide creation.  Otherwise create a slide.
    If WS.Cells(i, 35).Value = "No" Then
        sourcePres.Slides(1).Copy
        outputPres.Slides.Paste (outputPres.Slides.Count + 1)
        outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Report Date")).TextFrame.TextRange.Text = DateStr
        outputPres.Slides(outputPres.Slides.Count).Shapes("CommandButton1").Delete
    Else
        GoTo Skipped
    End If
    

    'Get the number of columns in use on the current row
    Dim LastCol As Long
    LastCol = WS.Rows(i).End(xlToRight).Column
    If LastCol = 16384 Then LastCol = 1 'For some reason if only column 1 has data it returns 16384, so correct it
    
    'Write the relevant data to the slide
    
    For j = 1 To LastCol
        Select Case j
            Case 1
                'Do Nothing
            Case 2
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Project Name")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 3
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Loco")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 4
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("ROA")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 5
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("ROA Date")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 6
                'Do Nothing
            Case 7
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Net Savings")).TextFrame.TextRange.Text = Format(WS.Cells(i, j).Value, "#,###")
            Case 8
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Project Manager")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 9
                'Do Nothing
            Case 10
                'Do Nothing
            Case 11
                'Do Nothing
            Case 12
                'Do Nothing
            Case 13
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Immediacy")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 14
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Urgency")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 15
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Percent Comp")).TextFrame.TextRange.Text = WS.Cells(i, j).Value * 100 & "%"
            Case 16
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 1).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 17
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 2).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 18
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 3).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 19
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 4).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 20
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 5).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 21
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 6).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 22
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 7).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 23
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 8).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 24
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 9).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 25
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 10).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 26
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 11).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 27
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 12).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 28
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 13).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 29
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 14).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 30
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 15).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 31
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 16).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 32
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 17).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 33
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 18).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 34
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 19).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 35
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Task Table")).Table.Cell(2, 20).Shape.TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 36
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("Current Sup")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
            Case 37
                outputPres.Slides(outputPres.Slides.Count).Shapes.Range(Array("New Sup")).TextFrame.TextRange.Text = WS.Cells(i, j).Value
        End Select
    Next
Skipped:
Next

WS.UnProtect "Password12!"
If (WS.AutoFilterMode And WS.FilterMode) Or WS.FilterMode Then
    WS.ShowAllData
End If

WS.Range("A1:AK60").Sort Key1:=WS.Columns(1), Order1:=xlAscending, Header:=xlYes

WS.Protect Password:="Password12!", AllowFiltering:=True

OWB.Close
Sleep (5000)
    
With outputPres
    .SaveCopyAs "https://Somethinggroup.sharepoint.com/sites/FR_GSI_MEA_Wave2-80-Projet/Shared Documents/80-[Project]/KZ8A&KZ4AT Project/Part 23 PM/Top 3 BCC RDTC/Weekly_Reports/Report" & DateStrA & ".pptx", ppSaveAsOpenXMLPresentation
End With

outputPres.Close

Sleep (10000)
    
ActivePresentation.SlideShowWindow.View.Exit

Dummy = MsgBox("Report slides have been generated", 0, "Complete")

End Sub

Collectives™ on Stack Overflow

VBA slide Delete method was working and has stopped

1 Answer 1

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related