PowerPoint每15秒触发Ctrl+R刷新的VBA代码实现求助

现有代码的可用性 #

你提供的RunOnTime和CancelOnTime是可用的定时框架，但缺少触发Ctrl+R的核心逻辑，需要补充模拟按键的功能才能实现需求。

修改后的完整代码 #

要实现每15秒自动触发Ctrl+R，需在原代码中添加模拟按键逻辑，同时修正dTime的作用域问题（原代码中dTime是过程级变量，取消定时时会找不到对应值）：

' 声明模块级变量，确保CancelOnTime能获取定时任务的时间
Dim dTime As Date

Sub RunOnTime()
    ' 模拟按下Ctrl+R组合键
    SendKeys "^r", True
    
    ' 设置下一次执行的时间（15秒后）
    dTime = Now + TimeSerial(0, 0, 15)
    Application.OnTime dTime, "RunOnTime"
End Sub

Sub CancelOnTime()
    On Error Resume Next ' 避免定时任务已取消时报错
    Application.OnTime dTime, "RunOnTime", , False
End Sub

关键细节说明 #

• SendKeys用法：SendKeys "^r", True里的^代表Ctrl键，r是目标按键，True表示等待按键操作完成后再继续执行后续代码。
• 模块级变量dTime：必须把dTime写在所有过程之外（模块顶部），否则CancelOnTime无法读取定时任务的时间，导致取消操作失效。
• 宏启用要求：保存PPT为.pptm格式（启用宏的演示文稿），否则代码无法运行。
• 启动与停止方式：
  • 启动自动刷新：按Alt+F8，选择RunOnTime执行。
  • 停止自动刷新：同样按Alt+F8，选择CancelOnTime执行。

额外注意事项 #

• SendKeys在PPT未处于激活窗口时可能失效，若遇到刷新失败，确保PPT是当前活动窗口。
• 如果你的数据刷新不需要依赖Ctrl+R，建议直接调用对应数据对象的Refresh方法（比如Power Query、嵌入网页对象的刷新接口），这种方式比模拟按键更稳定可靠。

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