パワーポイント マクロでスライド内の設置済み動画に対してループ再生するアニメーション設定 AnimationOrder=0で先頭ほか

パワーポイント マクロで動画の自動再生＋ループ再生を設定する

貼り付け済みの動画アイテム ppMediaTypeMovie に対して、
マクロで自動再生＋ループ再生のアニメ設定 AnimationSettings を行う。

0.やりたいこと テスト

知恵袋の質問をデバッグ、テストしてみます。
detail.chiebukuro.yahoo.co.jp
をテストしてみた。

＞powerpointに貼った動画をすべて自動再生＋ループ再生の設定にしようと
＞VBAをchatGPTにお願いしました。
＞
＞以下のものを実行しましたが、自動再生が設定されませんでした。
＞ループ再生のほうがちゃんとマクロにて設定されました。
＞
＞どこがまずいですか？
＞macでOSは最新、
＞powerpointは16.73を使用しています。よろしくお願いいたします。

Sub AutoPlayAndLoopVideos()
Dim slide As Slide
Dim shp As Shape

For Each slide In ActivePresentation.Slides
For Each shp In slide.Shapes
If shp.Type = msoMedia Then
If shp.MediaType = ppMediaTypeMovie Then
With shp.AnimationSettings.PlaySettings
.PlayOnEntry = msoTrue
.LoopUntilStopped = msoTrue
End With
End If
End If
Next shp
Next slide
End Sub

---

Windows10 MS365のPowerPointでテストしました
youtu.be
https://youtu.be/4Dw5WpEWq_I
目次
00:00 0.やりたいこと テスト
01:08 1.不具合確認 ループ再生OK 自動再生NG
03:23 2.改善案・改善点 アニメ設定 直前の動作と同時 にする
08:17 3.AnimationSettings.AnimationOrder = 0 で順番を先頭に
12:51 4.完成したソース と 再テスト

1.不具合確認

↑ループ再生は、OK
自動再生が設定されませんでした。

2.改善案・改善点

手前みそ解説だけど、
ken3memo.hatenablog.com
と
動画:マクロ パワポ アニメ設定 直前の動作と同時にする Effect.Timing.TriggerType = msoAnimTriggerWithPrevious
https://www.youtube.com/watch?v=n0wT7AL8wYU
から、
'直前の動作と一緒にする ppMediaTypeMovie の shp.に対して処理する
Set objEffect = objTimeLine.MainSequence.AddEffect(shp, msoAnimEffectFade)
'タイミングのセット
objEffect.Timing.TriggerType = msoAnimTriggerWithPrevious '直前の動作と同時

を参考にして、既存の動画タイミングの修正なので、
'直前の動作と一緒にする shp.AnimationSettings.AnimationOrderに対して処理する
Set objEffect = objTimeLine.MainSequence.Item(shp.AnimationSettings.AnimationOrder)
'.AnimationOrderがタイムラインの位置なので、そのアニメ設定にタイミングをセットする
'タイミングのセット
objEffect.Timing.TriggerType = msoAnimTriggerWithPrevious '直前の動作と同時

'ここから
Sub AutoPlayAndLoopVideos20230519修正2()
    Dim slide As slide
    Dim shp As Shape
    
    'アニメ効果
    Dim objTimeLine As PowerPoint.TimeLine  'タイムラインって日本語だと？何だろう？
    '↑このタイムラインにアニメ効果を追加していくイメージです
    Dim objEffect As PowerPoint.Effect  '効果
    
    For Each slide In ActivePresentation.Slides
    
        Set objTimeLine = slide.TimeLine  'スライドの下にタイムラインがあります
        
        For Each shp In slide.Shapes
            If shp.Type = msoMedia Then
            If shp.MediaType = ppMediaTypeMovie Then
                With shp.AnimationSettings.PlaySettings
                    .PlayOnEntry = msoTrue
                    .LoopUntilStopped = msoTrue
                End With
                '直前の動作と一緒にする shp.AnimationSettings.AnimationOrderに対して処理する
                Set objEffect = objTimeLine.MainSequence.Item(shp.AnimationSettings.AnimationOrder)
                '.AnimationOrderがタイムラインの位置なので、そのアニメ↑にタイミング↓をセットする
                'タイミングのセット
                objEffect.Timing.TriggerType = msoAnimTriggerWithPrevious '直前の動作と同時
            End If
        End If
        Next shp
    Next slide

    MsgBox "設定終了、動画のループをスライドショーで確認してください"

End Sub

'ここまで

3.AnimationSettings.AnimationOrder = 0 で順番を先頭に
動画リハーサル後にバグに気が付く

違う不具合を発見。
動画挿入前に別アニメが設定されていると・・・
んっ、違うことに気が付く・・・

直前の動作と一緒だと、
頭で、別のアニメが設定されていると、
タイミングがそのアニメの下になるだけで、自動再生しない・・・

VBA パワポ アニメ順番を先頭にする
とかで検索すると、
AnimationSettings.AnimationOrder
が見つかる。

なんだ、単純に、
shp.AnimationSettings.AnimationOrder = 0
直前の動作と同時とか気にしないで、
0番目、一番先に走ればいいのか。

やらかしたな・・・・

Sub AutoPlayAndLoopVideos20230519修正3()
    Dim slide As slide
    Dim shp As Shape
    
    For Each slide In ActivePresentation.Slides
        For Each shp In slide.Shapes
            If shp.Type = msoMedia Then
            If shp.MediaType = ppMediaTypeMovie Then
                With shp.AnimationSettings.PlaySettings
                    .PlayOnEntry = msoTrue
                    .LoopUntilStopped = msoTrue
                End With
                shp.AnimationSettings.AnimationOrder = 0  '単純に頭で再生にすればよい？
            End If
        End If
        Next shp
    Next slide

    MsgBox "設定終了、動画のループをスライドショーで確認してください"

End Sub

'ここまで

おっと、これだと、０番目にならないのか・・・
合わせて、作成して、やっとOK？

4.完成したソース と 再テスト

'ここから
Sub AutoPlayAndLoopVideos20230519修正4()
    Dim slide As slide
    Dim shp As Shape
    
    'アニメ効果
    Dim objTimeLine As PowerPoint.TimeLine  'タイムラインって日本語だと？何だろう？
    '↑このタイムラインにアニメ効果を追加していくイメージです
    Dim objEffect As PowerPoint.Effect  '効果
    
    For Each slide In ActivePresentation.Slides
    
        Set objTimeLine = slide.TimeLine  'スライドの下にタイムラインがあります
        
        For Each shp In slide.Shapes
            If shp.Type = msoMedia Then
            If shp.MediaType = ppMediaTypeMovie Then
                With shp.AnimationSettings.PlaySettings
                    .PlayOnEntry = msoTrue
                    .LoopUntilStopped = msoTrue
                End With
                shp.AnimationSettings.AnimationOrder = 0  'アニメの順番を先頭に移動する
                '直前の動作と一緒にする shp.AnimationSettings.AnimationOrderに対して処理する
                Set objEffect = objTimeLine.MainSequence.Item(shp.AnimationSettings.AnimationOrder)
                '.AnimationOrderがタイムラインの位置なので、そのアニメ↑にタイミング↓をセットする
                'タイミングのセット
                objEffect.Timing.TriggerType = msoAnimTriggerWithPrevious '直前の動作と同時
            End If
        End If
        Next shp
    Next slide

    MsgBox "設定終了、動画のループをスライドショーで確認してください"

End Sub

'ここまで

Windows10 MS365のPowerPointでテストしました
https://youtu.be/4Dw5WpEWq_I
目次
00:00 0.やりたいこと テスト
01:08 1.不具合確認 ループ再生OK 自動再生NG
03:23 2.改善案・改善点 アニメ設定 直前の動作と同時 にする
08:17 3.AnimationSettings.AnimationOrder = 0 で順番を先頭に
12:51 4.完成したソース と 再テスト

アニメ設定処理の参考となれば、幸いです。

知恵袋の質問に記載されていたchatGPT作成のコードに

AnimationSettings.AnimationOrder = 0  'アニメの順番を先頭に移動する
'直前の動作と一緒にする shp.AnimationSettings.AnimationOrderに対して処理する
Set objEffect = objTimeLine.MainSequence.Item(shp.AnimationSettings.AnimationOrder)
'.AnimationOrderがタイムラインの位置なので、そのアニメ↑にタイミング↓をセットする
objEffect.Timing.TriggerType = msoAnimTriggerWithPrevious '直前の動作と同時

にセットすると、、
ループ再生と自動再生が設定されると思います。