如何用外部程序（如Access）的VBA读取PPT播放中的音乐文件及进度

核心思路 #

PPT里的音乐/多媒体播放是绑定在时间轴的动画序列（AnimationSequence）中的，通过遍历幻灯片的动画对象，筛选出多媒体类型的动画，再借助MediaFormat对象就能获取播放状态、文件名及进度。

代码实现 #

1. 连接到正在放映的PPT实例

Dim pptApp As Object
Set pptApp = GetObject(, "PowerPoint.Application")

' 获取当前放映窗口
Dim activeSlideShow As Object
Set activeSlideShow = pptApp.ActivePresentation.SlideShowWindow
If activeSlideShow Is Nothing Then
    MsgBox "未检测到正在放映的PPT"
    Exit Sub
End If

2. 检测并获取正在播放的多媒体信息

遍历当前幻灯片的所有动画，筛选出正在播放的多媒体文件：

Dim currentSlide As Object
Set currentSlide = activeSlideShow.View.Slide

Dim eff As Object
Dim mediaFormat As Object

For Each eff In currentSlide.TimeLine.MainSequence
    ' 判断是否为多媒体动画（音乐/视频）
    If eff.Type = msoAnimMedia Then
        Set mediaFormat = eff.Shape.MediaFormat
        
        ' 检查播放状态
        If mediaFormat.IsPlaying Then
            ' 获取完整文件名
            Debug.Print "正在播放的文件：" & mediaFormat.FullName
            
            ' 计算播放进度（单位：秒）
            Dim currentPos As Double, totalDur As Double
            currentPos = mediaFormat.CurrentPosition / 1000
            totalDur = mediaFormat.Duration / 1000
            
            Debug.Print "播放进度：" & Round(currentPos / totalDur * 100, 2) & "%" & _
                        " (" & Round(currentPos, 2) & " / " & Round(totalDur, 2) & "秒)"
        End If
    End If
Next eff

关键说明 #

• 跨幻灯片播放处理：如果音乐设置了跨幻灯片播放，需要遍历演示文稿所有幻灯片的动画序列，而非仅当前幻灯片
• 单位转换：CurrentPosition和Duration属性返回值为毫秒，需除以1000转为秒
• 兼容性提示：若未引用PowerPoint对象库，可将msoAnimMedia替换为数值12，msoAnimPlaying替换为数值2
• 文件状态要求：多媒体文件需为嵌入或有效链接状态，否则FullName可能返回空值

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