VBA 幻灯片删除方法正在运行，但已停止

问题描述 投票：0回答：1

我有与此问题中强调的相同的问题：

Powerpoint VBA - 尝试删除幻灯片时出错

我的代码运行得很好，然后突然停止工作。运行时错误“-2147467259 (8000405)”对象“_Slide”的方法“删除”失败。 该代码从 Excel 电子表格读取数据并将其写入 PowerPoint 幻灯片。 然后，它“另存为”，然后删除当前演示文稿中所有创建的幻灯片，以使其恢复到“基本”状态。 中间还有一个幻灯片删除，当项目完成并且不需要幻灯片时。

如有任何帮助，我们将不胜感激。我已检查 Excel 和 PowerPoint 端的所有加载项均已禁用，并且我已尝试保存 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
vba powerpoint delete-method
1个回答
0
投票

问题解决了。两个主要变化：

  1. 我正在创建一张幻灯片，然后检查是否有必要，如果需要我会填充，如果不需要我会删除。 我改为首先检查幻灯片是否必要，并且仅在必要时才创建。

  2. 我正在将所需的幻灯片添加到“ActivePresentation”添加所有需要的幻灯片后，我执行了“另存为”，然后从“ActivePresentation”中删除了所有添加的幻灯片在新版本中，我没有将幻灯片添加到ActivePresentation而是输出演示。然后我保存输出演示文稿。 因此永远不需要删除幻灯片。

所以...我实际上并没有解决删除幻灯片的问题。 我刚刚消除了删除幻灯片的需要。

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
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.