VBA调用Presentations.Open打开PPT失败，需解决跨PPT幻灯片复制问题

错误Run-time error '-2147467259(80004005)'的核心原因是**Presentations.Open方法不支持通配符路径**，你代码里使用CFTC Reg Reporting*.pptx这种模糊匹配，导致方法无法定位到精确文件路径，从而触发报错。

以下是修复方案及优化后的代码：

关键修复与优化点 #

• 替换通配符，获取精确文件名：使用Dir函数遍历指定路径下符合规则的PPT文件，获取第一个匹配的完整文件名，解决Open方法不支持通配符的问题。
• 避免依赖ActivePresentation：用Presentation类型变量直接绑定当前和源演示文稿，避免切换活动窗口导致的引用混乱。
• 添加错误检查：针对文件不存在、打开失败、源幻灯片数量不足等场景做判断，提升代码健壮性。

修正后的完整代码 #

Sub copyFromPPT()
    Dim thisPres As Presentation
    Dim sourcePres As Presentation
    Dim sourcePath As String
    Dim ppt_SourceFile As String
    
    ' 绑定当前演示文稿对象
    Set thisPres = ActivePresentation
    sourcePath = thisPres.Path
    
    ' 用Dir函数获取符合匹配规则的第一个PPT文件
    ppt_SourceFile = Dir(sourcePath & "\CFTC Reg Reporting*.pptx")
    
    ' 检查是否找到目标文件
    If ppt_SourceFile = "" Then
        MsgBox "未找到符合条件的源PPT文件！", vbExclamation
        Exit Sub
    End If
    
    ' 尝试打开源演示文稿
    On Error Resume Next
    Set sourcePres = Presentations.Open(sourcePath & "\" & ppt_SourceFile)
    On Error GoTo 0
    
    ' 检查源文件是否成功打开
    If sourcePres Is Nothing Then
        MsgBox "无法打开源PPT文件，请检查文件是否被占用或损坏！", vbCritical
        Exit Sub
    End If
    
    ' 复制第1张幻灯片到当前演示文稿末尾（先检查源幻灯片数量）
    If sourcePres.Slides.Count >= 1 Then
        sourcePres.Slides(1).Copy
        thisPres.Slides.Paste
    End If
    
    ' 复制第2张幻灯片到当前演示文稿末尾
    If sourcePres.Slides.Count >= 2 Then
        sourcePres.Slides(2).Copy
        thisPres.Slides.Paste
    End If
    
    ' 关闭源演示文稿（不保存更改）
    sourcePres.Close SaveChanges:=ppSaveChangesNone
    ' 保存当前演示文稿
    thisPres.Save
    
    ' 释放对象变量
    Set sourcePres = Nothing
    Set thisPres = Nothing
    
    MsgBox "幻灯片复制完成！", vbInformation
End Sub

代码说明 #

1. 通配符处理：Dir函数会返回指定路径下第一个匹配CFTC Reg Reporting*.pptx的文件名，确保传入Presentations.Open的是精确路径。
2. 对象绑定：thisPres和sourcePres直接关联对应的演示文稿，所有操作都基于变量，避免了切换活动窗口带来的潜在错误。
3. 安全判断：提前检查文件是否存在、源幻灯片数量是否足够，避免因异常情况导致程序崩溃。
4. 源文件保护：关闭源文件时指定ppSaveChangesNone，防止误修改源PPT内容。

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