运行VBA Timer时PPT动画掉帧，单幻灯片正常多页场景出现异常

问题根因 #

该卡顿问题本质是多幻灯片场景下无间隔忙等循环的渲染开销激增导致：

• 仅单张幻灯片时，PowerPoint执行DoEvents仅需校验当前页的渲染状态、动画队列、触发事件规则，单次调用开销极低，即使密集调用也不会挤占动画渲染资源，因此运行完全正常。
• 新增幻灯片后，每次DoEvents调用都会额外遍历所有幻灯片的预加载状态、隐藏对象属性、全局事件绑定规则，你原有代码的循环无间隔调用DoEvents，每秒会触发数千次全量校验，直接占满PPT渲染线程资源，最终导致动画帧率暴跌到近似每秒1帧。

修复方案 #

• 首先替换原有的无间隔忙等逻辑，通过Windows API的Sleep方法降低DoEvents调用频率，既保留事件响应能力，又大幅降低校验开销。
• 宏运行时可额外关闭不必要的全局渲染校验，仅在需要修改形状可见性时恢复渲染状态。

兼容32/64位Office的改造后代码 #

首先在模块顶部声明Sleep API：

#If VBA7 Then
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

替换原有延迟逻辑：

Dim lag As Long: lag = 3
Dim start As Single: start = Timer

' 每10毫秒处理一次事件，调用频率从原有的每秒数千次降到100次，开销降低95%以上
Do While Timer < start + lag
    Sleep 10
    DoEvents
Loop

If disappear = True Then oSh.Visible = msoFalse

额外优化建议 #

• 如果需要更高精度的延迟，可将Sleep的参数调整为1~5毫秒，不要设为0，否则会变回无间隔调用的状态。
• 运行宏过程中不要修改非当前激活幻灯片的任何属性，避免触发不必要的跨页重绘。
• 如果幻灯片总数量超过20页，可额外在宏启动时先判断当前激活幻灯片是否为形状所属幻灯片，不匹配直接退出，减少无效校验。

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