ppt中如何批量插入MP3？

zzpsx · 发表于 2016-10-27 18:52

zpwtl · 发表于 2016-11-5 15:39

先把所需的MP3添加到剪辑管理器中，单击就可以在当前页面插入，能省略前面繁琐的插入步骤

weiyingde · 发表于 2016-12-3 19:16

给你一个思路：
这个可以实现，如果是每页插入指定的MP3，可以先将音频的文件的名称录入excel某一列中，然后用VBA代码插入；
也可以机动插入。一页插入一个MP3。

zzpsx · 发表于 2021-10-26 19:50

weiyingde 发表于 2016-12-3 19:16
给你一个思路：
这个可以实现，如果是每页插入指定的MP3，可以先将音频的文件的名称录入excel某一列中，然 ...

请问如何一页插入一个音频？

shenjianrong163 · 发表于 2021-10-28 21:21

本帖最后由 shenjianrong163 于 2021-10-28 23:25 编辑

试试这个。

Sub InsertMp3()
'如果mp3有固定的顺序，事先在文件名前加“001、002、003……”
Dim shp As Shape, L As Single, T As Single, W As Single, H As Single, Width As Single, Height As Single, i&, m&, arr
On Error Resume Next
Set myFolder = CreateObject("Shell.Application").BrowseForFolder(0, "GetFolder", 0)
If Not myFolder Is Nothing Then myPath$ = myFolder.Items.Item.Path Else MsgBox "没有选择文件夹！": Exit Sub
If Right(myPath, 1) <> "" Then myPath = myPath & ""
arr = ListAllFsoDic(myPath)
If UBound(arr) = -1 Then MsgBox "所选文件夹中没有mp3文件!请重新选择!": Exit Sub
m = ActivePresentation.Slides.Count
With ActivePresentation.PageSetup
Width = .SlideWidth '页面宽度
Height = .SlideHeight '页面高度
End With
L = Width - 60 '左边距
T = Height - 50 '上边距
W = 50 '宽度
H = 50 '高度
If m > UBound(arr) + 1 Then
For i = 1 To UBound(arr) + 1
With ActivePresentation.Slides(i)
Set shp = .Shapes.AddMediaObject(arr(i - 1), L, T, W, H)
End With
Next
Else
For i = 1 To m
With ActivePresentation.Slides(i)
Set shp = .Shapes.AddMediaObject(arr(i - 1), L, T, W, H)
End With
Next
End If
End Sub
Private Function ListAllFsoDic(myPath$, Optional k = 0)
Dim i&, j&, arr
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
d1(myPath) = ""
Set fso = CreateObject("Scripting.FileSystemObject")
Do While i < d1.Count
kr = d1.Keys
For Each f In fso.GetFolder(kr(i)).Files
If LCase(Right(f.Name, Len(f.Name) - InStrRev(f.Name, "."))) = "mp3" Then
j = j + 1: d2(j) = kr(i) & "" & f.Name
End If
Next
i = i + 1
For Each fd In fso.GetFolder(kr(i - 1)).SubFolders
d1(fd.Path) = " " & fd.Name & ""
Next
Loop
ListAllFsoDic = d2.Items
End Function

复制代码

shenjianrong163 · 发表于 2021-10-28 21:21

本帖最后由 shenjianrong163 于 2021-10-28 23:26 编辑

附件供参考：

每页插入一个mp3文件.zip (53.2 KB, 下载次数: 48)

xmeflame · 发表于 2024-5-20 20:18

shenjianrong163 发表于 2021-10-28 21:21
试试这个。

请问，可以发一个，插入嵌入式MP3的代码吗？

xmeflame · 发表于 2024-5-20 20:19

shenjianrong163 发表于 2021-10-28 21:21
附件供参考：

这个可以用，但是换一台电脑的话，里面的mp3就没有了

麻烦，帮帮忙看看，代码改改哪里，可以改成，插入嵌入式音频，谢谢了

shenjianrong163 · 发表于 2024-5-20 22:01

xmeflame 发表于 2024-5-20 20:18
请问，可以发一个，插入嵌入式MP3的代码吗？

office 2013以上版本，插入pptx文件中播放一遍，保存文件就包含mp3了。低版本可以下载“MP3 Addin”将mp3嵌入ppt中（此插件只支持32位PPT）:https://www.jb51.net/softs/151764.html

whuihui · 发表于 2024-6-21 11:08

https://www.bilibili.com/video/BV1hD421T7dH/
看这里

		自动登录	找回密码
密码			免费注册

ppt中如何批量插入MP3？

评分

评分

评分

浏览过的版块