VBA复制PPT幻灯片到新文件单步运行正常，直接执行仅重复最后一页

问题根因 #

• 全速运行时oldSlide.Copy将幻灯片写入系统剪贴板存在毫秒级延迟，你使用的CommandBars.ExecuteMso "PasteSourceFormatting"执行优先级远高于剪贴板IO操作，剪贴板还没更新当前复制的幻灯片内容，粘贴命令就已经执行，全程只有最后一次复制的内容有足够时间写入剪贴板，因此出现所有页面都是最后一页的问题。
• 单步调试时每步之间的人工间隔足够剪贴板完成写入，所以运行正常。
• ExecuteMso是应用级全局命令，没有明确绑定目标演示文稿的插入位置，运行时窗口焦点偏移也可能引发粘贴异常。

修复方案 #

推荐改用可控性更高的写法，完全规避剪贴板时序问题，修改后代码如下：

Public Sub SaveAs()
    Dim oldPresentation As Presentation, newPresentation As Presentation
    Dim i As Integer, count As Integer, path As String, newFileName As String
    
    path = ActivePresentation.path
    count = ActivePresentation.Slides.count
    Set oldPresentation = ActivePresentation
    Set newPresentation = Application.Presentations.Add
        
    For i = 1 To count
        If i <> 2 Then
            ' 直接从原演示文稿读取指定页插入新PPT，自动保留源格式，不操作剪贴板
            newPresentation.Slides.InsertFromFile _
                FileName:=oldPresentation.FullName, _
                Index:=newPresentation.Slides.count + 1, _
                SlideStart:=i, _
                SlideEnd:=i
        End If
    Next i

    newFileName = "\Test " & Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss") & ".pptx"
    newFileName = Replace(newFileName, ":", "-")

    With newPresentation
        .SaveCopyAs fileName:=path & newFileName, FileFormat:=ppSaveAsOpenXMLPresentation
    End With

    newPresentation.Close
End Sub

如果习惯用复制粘贴逻辑，也可以在原代码基础上增加剪贴板等待指令修复问题：

' 仅替换循环内的逻辑
For i = 1 To count
    If i <> 2 Then
        Set oldSlide = oldPresentation.Slides(i)
        oldSlide.Copy
        ' 释放控制权等待剪贴板写入完成
        DoEvents
        ' 明确指定粘贴到新PPT的末尾
        newPresentation.Slides.Paste newPresentation.Slides.count + 1
    End If
Next i

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