ppt中如何批量插入MP3？

zzpsx

zpwtl

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

weiyingde

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

zzpsx

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

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

shenjianrong163

试试这个。

1. Sub InsertMp3()
   
2.     '如果mp3有固定的顺序，事先在文件名前加“001、002、003……”
   
3.     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
   
4.     On Error Resume Next
   
5.     Set myFolder = CreateObject("Shell.Application").BrowseForFolder(0, "GetFolder", 0)
   
6.     If Not myFolder Is Nothing Then myPath$ = myFolder.Items.Item.Path Else MsgBox "没有选择文件夹！": Exit Sub
   
7.     If Right(myPath, 1) <> "" Then myPath = myPath & ""
   
8.     arr = ListAllFsoDic(myPath)
   
9.     If UBound(arr) = -1 Then MsgBox "所选文件夹中没有mp3文件!请重新选择!": Exit Sub
   
10.     m = ActivePresentation.Slides.Count
    
11.     With ActivePresentation.PageSetup
    
12.        Width = .SlideWidth '页面宽度
    
13.        Height = .SlideHeight '页面高度
    
14.     End With
    
15.     L = Width - 60 '左边距
    
16.     T = Height - 50 '上边距
    
17.     W = 50 '宽度
    
18.     H = 50 '高度
    
19.     If m > UBound(arr) + 1 Then
    
20.         For i = 1 To UBound(arr) + 1
    
21.             With ActivePresentation.Slides(i)
    
22.                 Set shp = .Shapes.AddMediaObject(arr(i - 1), L, T, W, H)
    
23.             End With
    
24.         Next
    
25.     Else
    
26.         For i = 1 To m
    
27.             With ActivePresentation.Slides(i)
    
28.                 Set shp = .Shapes.AddMediaObject(arr(i - 1), L, T, W, H)
    
29.             End With
    
30.         Next
    
31.     End If
    
32. End Sub
    
33. Private Function ListAllFsoDic(myPath$, Optional k = 0)
    
34.     Dim i&, j&, arr
    
35.     Set d1 = CreateObject("Scripting.Dictionary")
    
36.     Set d2 = CreateObject("Scripting.Dictionary")
    
37.     d1(myPath) = ""
    
38.     Set fso = CreateObject("Scripting.FileSystemObject")
    
39.     Do While i < d1.Count
    
40.         kr = d1.Keys
    
41.         For Each f In fso.GetFolder(kr(i)).Files
    
42.             If LCase(Right(f.Name, Len(f.Name) - InStrRev(f.Name, "."))) = "mp3" Then
    
43.                 j = j + 1: d2(j) = kr(i) & "" & f.Name
    
44.             End If
    
45.         Next
    
46.         i = i + 1
    
47.         For Each fd In fso.GetFolder(kr(i - 1)).SubFolders
    
48.                 d1(fd.Path) = " " & fd.Name & ""
    
49.         Next
    
50.     Loop
    
51.     ListAllFsoDic = d2.Items
    
52. End Function

复制代码

shenjianrong163

附件供参考：


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

2021-10-28 23:26 上传

点击文件名下载附件