Windows10下Excel VBA操作PPT形状时程序崩溃问题咨询

在Windows 10系统的MS Office Professional Plus 2013环境中，通过Excel VBA操作PowerPoint形状时，PowerPoint会自行崩溃关闭；但在Windows 7系统的同版本Office环境下运行完全正常。

相关代码如下：

Set wb = ThisWorkbook.Sheets("Chart")
    i = wb.Cells(wb.Rows.Count, 1).End(xlUp).Row
    For z = 1 To i
        sld = sld + 1
        PPTemp.Slides(2).Copy
        PPPres.Slides.Paste sld
        Set PPSlide = PPPres.Slides(sld)
        PPSlide.Shapes("Title").TextFrame.TextRange.Text = "Quantitative Ad Measurement Result" & vbNewLine & wb.Cells(z, 1).Value
        PPSlide.Shapes("Text 1").TextFrame.TextRange.Text = "The VIRTUAL ADS has " & IIf(wb.Cells(z, 1).Value < 0, WorksheetFunction.Text(Abs(wb.Cells(z, 2).Value), "0%") & " lower ", WorksheetFunction.Text(Abs(wb.Cells(z, 2).Value), "0%") & " higher ") & " higher TVR compared to the commercial break TVR on average."
        PPSlide.Shapes("Footer").TextFrame.TextRange.Text = "Data TVR based on TVR MBM Program & Break Program " & WorksheetFunction.Proper(wa.Range("D6").Value)
        wb.ChartObjects(wb.Cells(z, 1).Value & " " & wb.Cells(z, 3).Value).Copy
        PPSlide.Shapes.Paste
        Set PPShape = PPSlide.Shapes(PPSlide.Shapes.Count)
        PPShape.Width = 800
        PPShape.Height = 380
        PPShape.Top = 90
        PPShape.Left = 80
        PPPres.Slides(1).Select
    Next z

额外现象：若在PPPres.Slides(1).Select处设置断点，逐行运行代码，PowerPoint不会崩溃且程序可执行完毕。

• Win10下Office对象模型的资源调度差异：Windows 10系统中，Office 2013的COM对象模型对资源释放、异步操作的处理逻辑比Windows 7更严格。循环中频繁执行复制、粘贴、形状修改、幻灯片选择等操作时，PowerPoint进程来不及完成资源的同步清理，导致内存泄漏或对象引用冲突，最终触发崩溃。
• 冗余Select操作引发的对象冲突：循环末尾的PPPres.Slides(1).Select属于不必要操作，批量处理时频繁切换选中状态会干扰PowerPoint的UI线程和后台对象处理。逐行运行时系统有足够时间完成选中操作的资源同步，批量运行时则因UI线程与后台操作冲突导致崩溃。
• 粘贴操作的异步特性未被处理：PPSlide.Shapes.Paste是异步执行的操作，批量循环中代码未等待粘贴完成就立即修改形状属性，可能引用了尚未完全初始化的Shape对象，引发内存访问错误。逐行运行时的手动等待时间让粘贴操作完成，因此不会触发问题。

• 移除冗余的PPPres.Slides(1).Select操作，避免不必要的UI线程干扰。
• 在粘贴操作后添加DoEvents，让系统有时间完成异步操作和资源清理：

  wb.ChartObjects(wb.Cells(z, 1).Value & " " & wb.Cells(z, 3).Value).Copy
  PPSlide.Shapes.Paste
  DoEvents ' 等待粘贴操作完成
  Set PPShape = PPSlide.Shapes(PPSlide.Shapes.Count)
  

• 循环结束后及时释放所有PowerPoint对象引用，避免内存泄漏：

  Next z
  ' 释放对象
  Set PPShape = Nothing
  Set PPSlide = Nothing
  Set PPPres = Nothing
  Set PPTemp = Nothing
  

• 考虑禁用PowerPoint的屏幕更新，减少UI渲染开销：

  PPPres.Application.ScreenUpdating = False
  ' 循环代码...
  PPPres.Application.ScreenUpdating = True
  

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