使用 Excel VBA 删除多个 powerpoint 文件的未使用母版幻灯片

Question

Hello Stackoverflow community,

I wish to remove unused masterslides from multiples powerpoint presentation. The list of files is in an excel file. I wrote a macro that opens each powerpoint files. I found a macro that used within powerpoint VBA removes unused masterslide but doesn't work when I include it in my Excel macro... Also I don't manage to save and close each pwp files.

Macro that loops through files:

Dim myPresentation As Object
Dim PowerPointApp As Object
Set myPresentation = CreateObject("Powerpoint.application")

'Find last row of path files list
lastRow = Cells(Rows.Count, "A").End(xlUp).Row

'Looping through files
For i = 1 To lastRow
    
    'Defines pwp file to open
    DestinationPPT = Cells(i, "A")
    'opens pwp file
    myPresentation.presentations.Open DestinationPPT
    myPresentation.Visible = True
    
    'Then I would like to : remove unused master slide, save, close
    
Next i

End Sub 

Macro that works when used directly in pwp:

Sub SlideMasterCleanup()

Dim k As Integer
Dim n As Integer
Dim oPres As Presentation
Set oPres = ActivePresentation
On Error Resume Next
With oPres
    For k = 1 To .Designs.Count
        For n = .Designs(k).SlideMaster.CustomLayouts.Count To 1 Step -1
            .Designs(k).SlideMaster.CustomLayouts(n).Delete
        Next
    Next k
End With

End Sub

What could I do in order to:

• succeeding in removing masterslide in my Excel macro
• Save and close each pwp before going to the next

Thanks a lot

Answer 1

Here's a first shot at revising your code. Give it a try; if it works, great. If not, let us know what went wrong, and on what line of code. Use this ONLY on a copy of your presentation(s). I don't see where you've coded any way of determining whether a layout is used or not.

Option Explicit

Sub Main()

Dim myPresentation As Object
Dim PowerPointApp As Object
Set PowerPointApp = CreateObject("Powerpoint.application")

'Find last row of path files list
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

'Looping through files
For i = 1 To LastRow
    
    'Defines pwp file to open
    DestinationPPT = Cells(i, "A")
    'opens pwp file
    Set myPresentation = PowerPointApp.Presentations.Open(DestinationPPT)
    myPresentation.Visible = True
    
    'Then I would like to : remove unused master slide, save, close
    Call SlideMasterCleanup(myPresentation)
    
Next i

End Sub

Sub SlideMasterCleanup(oPres As Presentation)

Dim k As Integer
Dim n As Integer

On Error Resume Next
With oPres
    For k = 1 To .Designs.Count
        For n = .Designs(k).SlideMaster.CustomLayouts.Count To 1 Step -1
            .Designs(k).SlideMaster.CustomLayouts(n).Delete
        Next
    Next k
End With

oPres.Save
oPres.Close

End Sub