Search code examples
vbapowerpoint

How can I find and delete all custom layouts after a certain layout in PowerPoint?


I am migrating a lot of old presentations to a new design using VBA. I have created the new file from a template, copied each slide across and applied the correct custom layout that I need to each one. Once done, I am left with a load of the old custom layouts that are not used, and want to delete them all. The new design uses 50 custom layouts. Is there a way to find the ones after that 50 and delete them? Or delete all layouts after a layout of a specific name? Here is the code I'm using at the moment. This doesn't remove them all, for some reason. Any help is welcome.

    Dim colUsedLayouts As New Collection

For Each sld In NewPres.Slides
    colUsedLayouts.Add sld.CustomLayout
Next

Dim UsedLayout As CustomLayout
Dim LayoutHasBeenUsed As Boolean
Dim EndPointLogoFound As Boolean
For Each lay In NewPres.Designs(1).SlideMaster.CustomLayouts

    If Trim(LCase(lay.name)) = "blank no logo" Then 'Used the else statement so it doesn't delete the Blank No logo layout
        EndPointLogoFound = True
    Else
        If EndPointLogoFound Then
            LayoutHasBeenUsed = False
    
            For Each UsedLayout In colUsedLayouts
                If UsedLayout Is lay Then
                    LayoutHasBeenUsed = True
                End If
            Next
    
            If Not LayoutHasBeenUsed Then
                lay.Delete
            End If
        End If
    End If
Next

Solution

  • PowerPoint doesn't really track the order of slide layouts, so trying to delete layouts after a certain one isn't reliable. I would go by the layout name. Create a Select Case statement based on the layout name. In the first Case statement, place the names of all 50 good layouts. This Select Case statement will have no commands. Then create a Case Else statement that deletes any layout not found in in the first:

    Select Case lay.name
        Case "Title Slide", "Title and Content", "Comparison" 'etc. place all 50 names
            'do nothing
        Case Else
            lay.Delete
    End Select