更改动画动作“飞入”为“飞出”（申请加精）

leikaiyi123

dongdonggege 发表于 2019-5-31 18:00
这么多年了，大师还在坚持研究。
1、首先确保，在win7系统中，office安装后，“C:\Program Files (x86)\ ...

经测试省掉wav文件路径时，应将wav文件拷至与ppt在同一路径下。

leikaiyi123

chuhaiou 发表于 2019-5-21 09:34
飞出为何加不了声音如.AnimationSettings.SoundEffect.Name = "风铃"

经测试vba能加，先添加飞入，并添加声音，再改为飞出。

chuhaiou

csnAlex 发表于 2013-9-2 12:59
改飞入为飞出不用那么复杂，一句就可以。

若用ActivePresentation.Slides(1).TimeLine.MainSequence(1).Exit = 1更改自定义动画，其它的自定义动画就消失了。

dongdonggege

chuhaiou 发表于 2019-5-21 09:34
飞出为何加不了声音如.AnimationSettings.SoundEffect.Name = "风铃"

换个公式吧

1. Sub lingsheng2() '
   
2.     With ActivePresentation.Slides(1).Shapes(1).AnimationSettings
   
3.         .EntryEffect = ppEffectSwivel '方向：旋转
   
4.         .SoundEffect.Name = "风铃" '效果：声音
   
5.     End With
   
6. End Sub

复制代码

wweir

支持分享了！辛苦了！

ning84

ActiveWindow.Selection.ShapeRange的应用。

1.             Set ShpRng = Application.ActiveWindow.Selection.ShapeRange
   
2.             Debug.Print ShpRng.Name
   
3.             Stop
   
4.             ShpRng.Name = "T1"
   
5.             Debug.Print ShpRng.Name

复制代码

1. Private Sub ll3()
   
2.       Dim xChart As Chart
   
3.       Dim Sht As Worksheet
   
4.         Set xChart = Application.ActivePresentation.Slides(1).Shapes("C1").Chart
   
5.         ''
   
6.         xChart.ChartData.Activate
   
7.         'Stop
   
8.         Set Sht = xChart.ChartData.Workbook.Worksheets(1)
   
9.         Debug.Print Sht.Name
   
10.     Stop
    
11.     Dim Shp As Shape, Kk
    
12.     Dim ShpRng As ShapeRange
    
13.     Dim TxtRng2 As TextRange2
    
14.         Kk = 1
    
15.         For Each Shp In Application.ActivePresentation.Slides(1).Shapes
    
16.               If Shp.Type = 1 Then
    
17.                   Set TxtRng2 = Shp.TextFrame2.TextRange
    
18.                   Debug.Print Shp.Name, Shp.Type, TxtRng2.Text
    
19.                   Shp.Name = "N" & Kk
    
20.                   Kk = Kk + 1
    
21.                   Sht.Cells(Kk + 14, 1) = Shp.Name
    
22.                   Sht.Cells(Kk + 14, 2) = TxtRng2.Text
    
23.               End If
    
24.         Next Shp
    
25.         
    
26. End Sub

复制代码