使用VBA删除含指定关键词的PowerPoint幻灯片问题求助

我帮你梳理下原代码里的几个关键问题，然后给出修正后的完整代码，保证能实现你要的功能：

原代码的核心问题 #

1. 关键词错误：你要删除含CX404的幻灯片，但原代码里写的是CX400，完全不匹配
2. 匹配逻辑不合理：原代码要求文本框内容完全等于关键词，但实际幻灯片里的文本框往往是包含关键词+其他内容，不是纯关键词文本
3. 依赖活动窗口不安全：用ActivePresentation可能在多PPT打开时出错，不如直接用已引用的PP对象
4. 删除后未终止循环：删除幻灯片后继续遍历该幻灯片的形状，会触发运行时错误
5. 缺少保存步骤：原代码删除后直接关闭PPT，修改不会被保存，等于白删

修正后的完整代码 #

Public Sub DoFiles()
    Dim strFileName As String
    Dim strFolderName As String
    Dim PP As Presentation
    ' 设置目标文件夹路径（可根据实际修改）
    strFolderName = "D:\Users\Desktop\Shaon\pptss"
    strFileName = Dir(strFolderName & "\*.pptx*")
    
    Do While Len(strFileName) > 0
        Set PP = Presentations.Open(strFolderName & "\" & strFileName)
        Dim oSld As Slide
        Dim oShp As Shape
        Dim L As Long
        
        ' 从最后一张幻灯片往前遍历（避免删除后索引混乱）
        For L = PP.Slides.Count To 1 Step -1
            Set oSld = PP.Slides(L)
            Dim slideNeedsDelete As Boolean
            slideNeedsDelete = False ' 初始化删除标记
            
            For Each oShp In oSld.Shapes
                ' 先确保形状有文本框且包含文本
                If oShp.HasTextFrame And oShp.TextFrame.HasText Then
                    ' 转大写后检查是否包含目标关键词（不区分大小写）
                    If InStr(1, UCase(oShp.TextFrame.TextRange.Text), "CX404") > 0 _
                        Or InStr(1, UCase(oShp.TextFrame.TextRange.Text), "AR50") > 0 Then
                        slideNeedsDelete = True
                        Exit For ' 找到关键词就停止检查当前幻灯片的其他形状
                    End If
                End If
            Next oShp
            
            ' 如果标记为需要删除，则执行删除操作
            If slideNeedsDelete Then
                oSld.Delete
            End If
        Next L
        
        PP.Save ' 必须保存，否则删除操作不会生效
        PP.Close
        strFileName = Dir ' 遍历下一个PPT文件
    Loop
End Sub

关键修改点说明 #

• 修正关键词：把CX400替换成你需要的CX404
• 模糊匹配逻辑：用InStr函数检查文本中是否包含关键词，支持文本框内有其他内容的场景
• 安全引用对象：全程用PP对象操作打开的演示文稿，不依赖活动窗口
• 添加删除标记：用布尔值标记是否需要删除，避免删除后继续遍历无效幻灯片的形状
• 强制保存：新增PP.Save，确保删除操作被保存到文件中

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