PowerPoint VBA如何删除指定自定义版式后的所有未使用版式

你正向遍历CustomLayouts集合时直接执行删除操作，每删除一个版式，集合会自动重排索引，后续版式的序号全部前移1位，但遍历指针会继续向后移动，直接跳过下一个待检查的版式，最终残留多余项。

直接从集合末尾倒序遍历，检查所有索引大于50的版式，未被幻灯片使用的直接删除即可。

Sub DeleteLayoutsAfterFixedIndex()
    Dim NewPres As Presentation
    ' 替换为你实际操作的演示文稿变量，和原有代码逻辑保持一致即可
    Set NewPres = ActivePresentation
    
    Dim colUsedLayouts As New Collection
    Dim sld As Slide
    ' 收集所有正在被幻灯片使用的版式
    For Each sld In NewPres.Slides
        colUsedLayouts.Add sld.CustomLayout
    Next
    
    Dim lay As CustomLayout
    Dim i As Long
    Dim layoutIsUsed As Boolean
    Dim usedLay As CustomLayout
    Const KEEP_LAYOUT_COUNT As Long = 50 ' 固定保留前50个版式
    
    ' 倒序遍历版式集合，从最后一个开始往前检查，避免删除导致的索引错位
    With NewPres.Designs(1).SlideMaster.CustomLayouts
        For i = .Count To KEEP_LAYOUT_COUNT + 1 Step -1
            Set lay = .Item(i)
            layoutIsUsed = False
            
            ' 检查当前版式是否被使用
            For Each usedLay In colUsedLayouts
                If usedLay Is lay Then
                    layoutIsUsed = True
                    Exit For
                End If
            Next
            
            ' 仅删除未被使用的版式
            If Not layoutIsUsed Then
                lay.Delete
            End If
        Next i
    End With
End Sub

先定位到作为分界点的指定名称版式，再倒序删除该版式之后所有未被使用的项，同时增加容错判断，避免找不到指定版式时误删内容。

Sub DeleteLayoutsAfterSpecifiedLayout()
    Dim NewPres As Presentation
    Set NewPres = ActivePresentation ' 替换为你实际操作的演示文稿对象
    
    Dim colUsedLayouts As New Collection
    Dim sld As Slide
    ' 收集所有在用版式
    For Each sld In NewPres.Slides
        colUsedLayouts.Add sld.CustomLayout
    Next
    
    ' 作为分界点的版式名称，该版式本身会被保留
    Const BOUNDARY_LAYOUT_NAME As String = "blank no logo"
    Dim lay As CustomLayout
    Dim i As Long
    Dim boundaryIndex As Long
    Dim layoutIsUsed As Boolean
    Dim usedLay As CustomLayout
    
    ' 先定位分界版式的索引位置
    boundaryIndex = 0
    With NewPres.Designs(1).SlideMaster.CustomLayouts
        For i = 1 To .Count
            If Trim(LCase(.Item(i).Name)) = Trim(LCase(BOUNDARY_LAYOUT_NAME)) Then
                boundaryIndex = i
                Exit For
            End If
        Next i
        
        ' 未找到分界版式时直接终止，避免误删
        If boundaryIndex = 0 Then
            MsgBox "未找到指定名称的分界版式，操作终止"
            Exit Sub
        End If
        
        ' 倒序遍历分界位置之后的所有版式
        For i = .Count To boundaryIndex + 1 Step -1
            Set lay = .Item(i)
            layoutIsUsed = False
            
            For Each usedLay In colUsedLayouts
                If usedLay Is lay Then
                    layoutIsUsed = True
                    Exit For
                End If
            Next
            
            If Not layoutIsUsed Then
                lay.Delete
            End If
        Next i
    End With
End Sub

• 遍历集合并执行删除操作时，必须从集合末尾向前倒序遍历，这是解决漏删问题的核心
• 代码中增加了Exit For逻辑，确认版式被使用后立刻跳出检查循环，幻灯片、版式数量较多时能大幅提升运行速度
• 所有正在被幻灯片引用的版式都会被保留，不会出现幻灯片版式丢失、显示异常的问题
• 如果你的文件包含多个设计母版（多个Design对象），可以循环遍历NewPres.Designs集合，对每个母版单独执行上述清理逻辑即可

内容的提问来源于stack exchange，提问作者Operandi