PPT VBA怎样改变音乐的触发器

shenjianrong163

用PPT VBA插入音乐后，页面中自动添加音乐的触发器（单击音乐图标触发），页面中有一个矩形（名为“矩形1”）,想通过VBA将音乐的触发器更改为矩形，请教怎样实现？谢谢！

1. Sub InsertMp3()
   
2.     Dim shp As Shape, L As Single, T As Single, W As Single, H As Single, myPath$, osp As Shape
   
3.     On Error Resume Next
   
4.     myPath = ActivePresentation.Path & "\ClockMusic.mp3"
   
5.     With ActivePresentation.PageSetup
   
6.        W = .SlideWidth '页面宽度
   
7.        H = .SlideHeight '页面高度
   
8.     End With
   
9.     L = W - 60 '左边距
   
10.     T = H - 50 '上边距
    
11.     With ActivePresentation.Slides(1)
    
12.         Set shp = .Shapes.AddMediaObject2(myPath, msoFalse, msoTrue, L, T)
    
13.         Set osp = .Shapes("矩形1")
    
14.     End With
    
15. End Sub
    

复制代码

VBA怎样改变音乐的触发器.zip (181.83 KB, 下载次数: 20)

2022-3-5 11:51 上传

点击文件名下载附件

约定的童话

PPT都没法录制，涉及盲区了

dongdonggege

这句改为

1. Set shp = .Shapes.AddMediaObject2(myPath, L, T, 48, 48)

复制代码

shenjianrong163

dongdonggege 发表于 2022-10-8 09:38
这句改为

谢谢，想通过单击“矩形1”触发插入的mp3,不知道怎样实现？

dongdonggege

这个没法做。原理是这样的，当你插入音乐，音乐图标自动就有一个触发器，这是触发ClockMusic.mp3，
当你用“”矩形1“触发这个音乐图标，就是空的。它不能触发音乐。
给你两段代码，都是完整的，请参考下。审核需要时间。

1. Sub InsertMp3()
   
2.     Dim shp1 As Shape, shp2 As Shape, oEffect As Effect, L As Single, T As Single, W As Single, H As Single, myPath$
   
3.     myPath = "c:" & "\ClockMusic.mp3"
   
4.     L = W - 60 '左边距
   
5.     T = H - 50 '上边距
   
6.     Set shp1 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRectangle, 170, 190, 130, 28)
   
7.     Set shp2 = ActivePresentation.Slides(1).Shapes.AddMediaObject(myPath, L, T, 48, 48)
   
8.     Set oEffect = ActivePresentation.Slides(1).TimeLine.InteractiveSequences.Add().AddEffect(Shape:=shp2, effectId:=msoAnimEffectCustom, trigger:=msoAnimTriggerOnShapeClick)
   
9.     With oEffect.Timing
   
10.         .Duration = 5
    
11.         .TriggerShape = shp1
    
12.     End With
    
13.    
    
14. End Sub
    
15. 
    
16. Sub AddShapeSetTiming()
    
17. '向幻灯片添加两个形状，并对该形状添加动画，然后在单击其他形状后开始动画。
    
18.     Dim effDiamond As Effect
    
19.     Dim shp2 As Shape
    
20.     Set shp1 = ActivePresentation.Slides(1).Shapes.AddShape(Type:=msoShapeOval, Left:=400, Top:=100, Width:=100, Height:=50)
    
21.     Set shp2 = ActivePresentation.Slides(1).Shapes.AddShape(Type:=msoShapeRectangle, Left:=100, Top:=100, Width:=50, Height:=50)
    
22.     Set effDiamond = ActivePresentation.Slides(1).TimeLine.InteractiveSequences.Add().AddEffect(Shape:=shp2, effectId:=msoAnimEffectPathDiamond, trigger:=msoAnimTriggerOnShapeClick)
    
23. 
    
24.     With effDiamond.Timing
    
25.         .Duration = 5
    
26.         .TriggerShape = shp1
    
27.     End With
    
28. End Sub

复制代码

dongdonggege

用个按钮播放时插入音乐不行吗？

dongdonggege

.SoundEffect.Name出现问题，需要修改，上个帖子还在审核中。
请看代码：

1. 
   
2. Sub InsertMp3()
   
3.     Dim shp1 As Shape, shp2 As Shape, oEffect As Effect, L As Single, T As Single, W As Single, H As Single, myPath$
   
4.     myPath = "c:" & "\ClockMusic.mp3"
   
5.     L = W - 60 '左边距
   
6.     T = H - 50 '上边距
   
7.     Set shp1 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRectangle, 170, 190, 130, 28)
   
8.     Set shp2 = ActivePresentation.Slides(1).Shapes.AddMediaObject(myPath, L, T, 48, 48)
   
9.     With shp1.TextFrame.TextRange.ActionSettings(ppMouseClick)
   
10.         .Action = ppActionNone
    
11.         .SoundEffect.Name = myPath
    
12.         .AnimateAction = msoFalse
    
13.     End With
    
14. End Sub

复制代码

dongdonggege

这样行了。

1. 
   
2. Sub Macro9()
   
3.    
   
4.     ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeRectangle, 170, 190, 130, 28).Select
   
5.     With ActiveWindow.Selection.ShapeRange.ActionSettings(ppMouseClick)
   
6.         .Action = ppActionNone
   
7.         .SoundEffect.Name = "Test.wav"
   
8.         .AnimateAction = msoFalse
   
9.     End With
   
10. End Sub
    

复制代码

仅供参考。

dongdonggege

这个属于触发器转移，我没办法研究了，如果你研究好了，请共享程序，谢谢。

shenjianrong163

dongdonggege 发表于 2022-10-11 09:04
这个属于触发器转移，我没办法研究了，如果你研究好了，请共享程序，谢谢。

好的，谢谢帮助！