パワポ アニメ フェードアウト 終了のアニメーションを連続セット TimeLineのMainSequenceと InteractiveSequences違いなどをデバッグ解説

終了、フェードアウトのアニメーションを複数の図形・シェイプに連続でセットする。
パワーポイントのアニメを設置するマクロコードの紹介と解説です。

タイルで隠す？アニメーションの終了・フェードで消す

#PowerPointVBA #アニメーション #出して消す #直前の動作と同時 #順番 #モザイク
youtu.be
https://youtu.be/9PNq6QRLtZ0
目次
00:00 やりたいこと、実行結果を見せます
00:43 TimeLineのMainSequenceとInteractiveSequences違い
04:25 マクロでエフェクト効果のフェードを追加
06:00 フェードをイン(開始)、アウト(終了)を切り替えたいので Effect.Exit = msoTrue
08:58 選択図形・シェイプ全てをフェードアウトする
12:06 ※直前の動作と同時の設定も忘れないでね
14:12 3.結合テスト 個別と一括 フェードアウトの設定を合わせる
15:23 例題1:画像を長方形で目隠し クリックされた目隠しを消す
17:40 例題2:ランキングを長方形で目隠し クリックされた目隠しを消す
19:09 例題3:女性の姿をブロックで目隠し クリックされた目隠しを消す

1.画像をクリックするとフェードで消えるアニメーションをセット

ポイントは、
'スライドの下にタイムラインがあります
Set objTimeLine = objSLD.TimeLine

タイムラインには、二つ
順番に流れる MainSequence
と
クリック動作で動く InteractiveSequences
が存在します。

今回は、クリックで動作させたいので、
'インタラクティブ 双方向の順序を追加 (類似でいつも使っているのはMainSequence余談脱線)
Set seqInteractive = objTimeLine.InteractiveSequences.Add(1) '順序の追加、新規順序

次に エフェクト 効果でフェードを追加
.AddTriggerEffectを使い

'操作のシェイプobjShape, 効果はフェード, シェイプクリック時にトリガー, トリガーとなるシェイプ
Set objEffect = seqInteractive.AddTriggerEffect( _
                    objShape, _
                    msoAnimEffectFade, _
                    msoAnimTriggerOnShapeClick, _
                    objShape)

最後に、、
フェードをイン(開始)、アウト(終了)
を切り替えたいので、
objEffect.Exit = msoTrue '終了のアニメにする※ここで、終了セット
しています。

'選択されたシェイプにアニメ効果を追加する
'自分自身 シェイプが押されたら、自身を消す 終了アニメの追加
Sub pp選択Shapeにフェードアウトを追加_1個別にアニメ追加()

    If ActiveWindow.Selection.Type <> ppSelectionShapes Then  '種類の判断
        MsgBox "Shape図形やテキストボックスを選択してね"
        Exit Sub
    End If
    
    If ActiveWindow.Selection.ShapeRange.Count = 0 Then  '件数の判断
        MsgBox "Shape図形やテキストボックスを選択してね"
        Exit Sub
    End If


    Dim nPAGE As Integer
    Dim objSLD As PowerPoint.Slide   'スライド
    Dim objShape As PowerPoint.Shape 'シェイプ
    
    nPAGE = ActiveWindow.Selection.SlideRange.SlideIndex '現在選択しているページ
    Set objSLD = ActivePresentation.Slides(nPAGE)  'プレゼンの下、スライドnページをセット
    
    'アニメ効果
    Dim objTimeLine As PowerPoint.TimeLine  'タイムラインって日本語だと？何だろう？
    Set objTimeLine = objSLD.TimeLine  'スライドの下にタイムラインがあります
  
    '↑このタイムラインにアニメ効果を追加していくイメージです
    Dim objEffect As PowerPoint.Effect  '効果
    Dim seqInteractive As PowerPoint.Sequence  'シーケンス 順序 : インタラクティブ？
    
    '複数選択の1個目～ アニメを追加、クリック時にする
    Dim n As Integer  'カウンター
    For n = 1 To ActiveWindow.Selection.ShapeRange.Count '選択された数までループ
        Set objShape = ActiveWindow.Selection.ShapeRange(n) '←このシェイプを↓アニメ効果を追加
        
        'インタラクティブ 双方向の順序を追加 (類似でいつも使っているのはMainSequence余談脱線)
        Set seqInteractive = objTimeLine.InteractiveSequences.Add(1) '順序の追加、新規順序

        '次に エフェクト 効果を追加 セット .AddTriggerEffectを使い
        '操作のシェイプobjShape, 効果はフェード, シェイプクリック時にトリガー, トリガーとなるシェイプ
        Set objEffect = seqInteractive.AddTriggerEffect( _
                            objShape, _
                            msoAnimEffectFade, _
                            msoAnimTriggerOnShapeClick, _
                            objShape)
        
        objEffect.Exit = msoTrue  '終了のアニメにする※ここで、終了セット

    Next

    MsgBox "処理終了、アニメーションウインドで確認してください"

End Sub

1.1 Effect.Exit = msoTrue 終了のアニメをテスト

追加説明で、
Effect.Exit = msoTrue 終了のアニメ
としていたので、
これをセットしないと、どうなるか？

コメントにしてみます。
※フェードインの表示で、自分自身をトリガーなんて・・・
　って、お話でした。
視聴者の声:※※時間稼ぎするなよ、次、次。

2.削除全て と名前の付いたシェイプ をトリガーにして、全てをフェードアウトする

個別のシェイプをフェードアウトができたので、
あとは、
削除全て など、名前の付いたシェイプを押すと動作するアニメを設定してみたいと思います。

と言っても、

'操作のシェイプobjShape, 効果はフェード, シェイプクリック時にトリガー, トリガーとなるシェイプ
Set objEffect = seqInteractive.AddTriggerEffect( _
                    objShape, _
                    msoAnimEffectFade, _
                    msoAnimTriggerOnShapeClick, _
                    objShape)

↑ここの、自分自身 objShape を objTriggerShape
目的のシェイプに変えるだけです。

※直前の動作と同時の設定も忘れないでね
'タイミングのセット
objEffect.Timing.TriggerType = msoAnimTriggerWithPrevious '直前の動作と同時
複数の図形・シェイプを同時にフェードアウト、終了させたかったので、
直前の動作と同時にしています。

'選択されたシェイプにアニメ効果を追加する
'削除全て と名前の付いたシェイプ をトリガーとする
'フェードアウト 終了アニメの追加
Sub pp選択Shapeにフェードアウトを追加_2全て連続()
    If ActiveWindow.Selection.Type <> ppSelectionShapes Then  '種類の判断
        MsgBox "Shape図形やテキストボックスを選択してね"
        Exit Sub
    End If
    
    If ActiveWindow.Selection.ShapeRange.Count = 0 Then  '件数の判断
        MsgBox "Shape図形やテキストボックスを選択してね"
        Exit Sub
    End If

    Dim nPAGE As Integer
    Dim objSLD As PowerPoint.Slide   'スライド
    Dim objShape As PowerPoint.Shape 'シェイプ
    
    nPAGE = ActiveWindow.Selection.SlideRange.SlideIndex '現在選択しているページ
    Set objSLD = ActivePresentation.Slides(nPAGE)  'プレゼンの下、スライドnページをセット
    
    'トリガーシェイプの用意
    Const strShpName = "削除全て"  '削除全て と 名前を付けたトリガーシェイプを用意
    
    Dim objTriggerShape As Shape   'Const↑↓じゃなくて、直でよかったか？ぉぃぉぃ
    Set objTriggerShape = Nothing  '初期化、エラーチェックもかねて
    On Error Resume Next   '↓でSet 取得エラー時に次へ トリガー用Shpが無かったとき
    Set objTriggerShape = objSLD.Shapes(strShpName)
    On Error GoTo 0  'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意
    '↑単純に、.Open "ファイル名" で開いただけです
    If objTriggerShape Is Nothing Then
        MsgBox "トリガー用の" & strShpName & "が見つからない。確認してください", vbExclamation
        Exit Sub
    End If
    
    'アニメ効果
    Dim objTimeLine As PowerPoint.TimeLine  'タイムラインって日本語だと？何だろう？
    Set objTimeLine = objSLD.TimeLine  'スライドの下にタイムラインがあります
  
    '↑このタイムラインにアニメ効果を追加していくイメージです
    Dim objEffect As PowerPoint.Effect  '効果
    Dim seqInteractive As PowerPoint.Sequence  'シーケンス 順序 : インタラクティブ？
    
    '複数選択の1個目～ アニメを追加、クリック時にする
    Dim n As Integer  'カウンター
    For n = 1 To ActiveWindow.Selection.ShapeRange.Count '選択された数までループ
        Set objShape = ActiveWindow.Selection.ShapeRange(n) '←このシェイプを↓アニメ効果を追加
        
        'インタラクティブ 双方向の順序を追加 (類似でいつも使っているのはMainSequence余談脱線)
        Set seqInteractive = objTimeLine.InteractiveSequences.Add(1) '順序の追加、新規順序

        '次に エフェクト 効果を追加 セット .AddTriggerEffectを使い
        '操作のシェイプobjShape, 効果はフェード, シェイプクリック時にトリガー, トリガーとなるシェイプ
        Set objEffect = seqInteractive.AddTriggerEffect( _
                            objShape, _
                            msoAnimEffectFade, _
                            msoAnimTriggerOnShapeClick, _
                            objTriggerShape)
        
        objEffect.Exit = msoTrue  '終了のアニメにする※ここで、終了セット

        'タイミングのセット
        objEffect.Timing.TriggerType = msoAnimTriggerWithPrevious '直前の動作と同時
        
    Next

    MsgBox "処理終了、アニメーションウインドで確認してください"

End Sub

2.1 直前の動作と同時 Timing.TriggerType = msoAnimTriggerWithPrevious をやらないと

直前の動作と同時にしないと、
複数クリックで進むので、
これは、これで、おもしろい？

やってみる。

3.結合テスト 個別と一括 フェードアウトの設定を合わせる

単純に、コードを追加して、1と2を合わせました。

'選択されたシェイプにアニメ効果を追加する
'個別のシェイプを押したらフェードアウトで消す
'And
'削除全て と名前の付いたシェイプで 全てフェードアウト
'フェードアウト 終了アニメの追加 サンプル
Sub pp選択Shapeにフェードアウトを追加_3結合テスト()
    If ActiveWindow.Selection.Type <> ppSelectionShapes Then  '種類の判断
        MsgBox "Shape図形やテキストボックスを選択してね"
        Exit Sub
    End If
    
    If ActiveWindow.Selection.ShapeRange.Count = 0 Then  '件数の判断
        MsgBox "Shape図形やテキストボックスを選択してね"
        Exit Sub
    End If

    Dim nPAGE As Integer
    Dim objSLD As PowerPoint.Slide   'スライド
    Dim objShape As PowerPoint.Shape 'シェイプ
    
    nPAGE = ActiveWindow.Selection.SlideRange.SlideIndex '現在選択しているページ
    Set objSLD = ActivePresentation.Slides(nPAGE)  'プレゼンの下、スライドnページをセット
    
    'トリガーシェイプの用意
    Const strShpName = "削除全て"  '削除全て と 名前を付けたトリガーシェイプを用意
    
    Dim objTriggerShape As Shape   'Const↑↓じゃなくて、直でよかったか？ぉぃぉぃ
    Set objTriggerShape = Nothing  '初期化、エラーチェックもかねて
    On Error Resume Next   '↓でSet 取得エラー時に次へ トリガー用Shpが無かったとき
    Set objTriggerShape = objSLD.Shapes(strShpName)
    On Error GoTo 0  'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意
    '↑単純に、.Open "ファイル名" で開いただけです
    If objTriggerShape Is Nothing Then
        MsgBox "トリガー用の" & strShpName & "が見つからない。確認してください", vbExclamation
        Exit Sub
    End If
    
    'アニメ効果
    Dim objTimeLine As PowerPoint.TimeLine  'タイムラインって日本語だと？何だろう？
    Set objTimeLine = objSLD.TimeLine  'スライドの下にタイムラインがあります
  
    '↑このタイムラインにアニメ効果を追加していくイメージです
    Dim objEffect As PowerPoint.Effect  '効果
    Dim seqInteractive As PowerPoint.Sequence  'シーケンス 順序 : インタラクティブ？
    
    '複数選択の1個目～ アニメを追加、クリック時にする
    Dim n As Integer  'カウンター
    For n = 1 To ActiveWindow.Selection.ShapeRange.Count '選択された数までループ
        Set objShape = ActiveWindow.Selection.ShapeRange(n) '←このシェイプを↓アニメ効果を追加
        
        'インタラクティブ 双方向の順序を追加 (類似でいつも使っているのはMainSequence余談脱線)
        Set seqInteractive = objTimeLine.InteractiveSequences.Add(1) '順序の追加、新規順序

        '次に エフェクト 効果を追加 セット .AddTriggerEffectを使い
        '操作のシェイプobjShape, 効果はフェード, シェイプクリック時にトリガー, トリガーとなるシェイプ
        Set objEffect = seqInteractive.AddTriggerEffect( _
                            objShape, _
                            msoAnimEffectFade, _
                            msoAnimTriggerOnShapeClick, _
                            objTriggerShape)
        objEffect.Exit = msoTrue  '終了のアニメにする※ここで、終了セット
        'タイミングのセット
        objEffect.Timing.TriggerType = msoAnimTriggerWithPrevious '直前の動作と同時
        Set objEffect = Nothing   '念のためクリア

        '個別をただ繰り返しただけ？
        '次に エフェクト 効果を追加 セット .AddTriggerEffectを使い
        '操作のシェイプobjShape, 効果はフェード, シェイプクリック時にトリガー, トリガーとなるシェイプ
        Set objEffect = seqInteractive.AddTriggerEffect( _
                            objShape, _
                            msoAnimEffectFade, _
                            msoAnimTriggerOnShapeClick, _
                            objShape)
        
        objEffect.Exit = msoTrue  '終了のアニメにする※ここで、終了セット
        
    Next

    MsgBox "処理終了、アニメーションウインドで確認してください"

End Sub

4.終わりの挨拶

複数の図形・シェイプに手作業で設定すると大変なので、
複数選択、アニメ追加のマクロ処理で参考となれば幸いです。

アレンジして使ってみてください。

---

パワポ VBA アニメの過去記事:
ken3memo.hatenablog.com

ken3memo.hatenablog.com

ken3memo.hatenablog.com

---

AIイラストで使用したプロンプト:
お店・店舗の外シャッターにスプレーで描かれた絵をモップを使い消している男性作業員をイラストで描いてください。
Illustration of a male worker using a mop to remove a spray-painted picture on the outside shutter of a store or store.

夏です。プールサイドを歩く女性のイラストを描いてください。
It is summer. Please draw an illustration of a woman walking by the pool in a bathing suit.