VBSからPowerPoint を起動して スライドショーの実行 SlideShowSettings.Run 自動実行もどきを作成してみた

タイトルサムネイル

単純に SlideShowSettings.Run して、n秒間待っただけでした・・・
VBSでスライドショーの 自動実行もどき 偽物を作成してみます。
youtu.be
https://youtu.be/v0ADG_l4QY8
目次
00:00 0.あいさつ
01:20 1.過去のコードをコピペして、実行してみます
02:22 2.スライドの画面切り替えのタイミングを0にする
05:12 失敗例
07:10 ゼロ秒をセットして次に進ませる

1.過去のコードをコピペして、実行してみます

VBA(vbs)で パワーポイント スライドショー の 自動実行 に チャレンジ
ken3memo.hatenablog.com
の
test.vbs
をコピペして、コメントを追加

'20220508スライド再生テスト001.VBSに保存して、実行
 Set oApp = CreateObject("PowerPoint.Application")
 oApp.Visible = True '可視にする

 oApp.Presentations.Open("d:\JRA_TEST\20220508\pptest.pptx")
 'WScript.Sleep(1000) '1秒待つ ※これが無いと、下の.Runがうまく動作しなかった、なぜ？
 'あれ？無くても動いた、気になるけど、なくていいか。

 oApp.ActivePresentation.SlideShowSettings.Run  'スライドショーの実行 F5的なヤツ

 For p=1 To 3  'ループでとりあえず3ページ
     WScript.Sleep(5000) '５秒待つ
     oApp.SlideShowWindows(1).View.Next '次のページ
 Next

 oApp.ActivePresentation.Application.Quit  '抜ける パワポ終了
'-----------

ナレーション付きだと、うまくいかなかった・・・なぜ？

2.スライドの画面切り替えのタイミングを0にする

画面切り替え　
切り替えのタイミング
自動00:00.00 にして

スライドショー .RUNのあと
スライド全体の秒数待つ
おいおい、それでいいのか？
自動実行するスライドは
ナレーション付きなので、
この姑息な手段でテスト

こんな感じで、
実行できたと思います

'20220508スライド再生テスト002.VBSに保存して、実行

 Set oApp = CreateObject("PowerPoint.Application")
 oApp.Visible = True '可視にする

 oApp.Presentations.Open("d:\JRA_TEST\20220508\pptest002.pptx")
 'WScript.Sleep(2000) '2秒待つ ※これが無いと、下の.Runがうまく動作しなかった、なぜ？
 'あれ？無くても動いた、気になるけど、なくていいか。

 oApp.ActivePresentation.SlideShowSettings.Run  'スライドショーの実行 F5的なヤツ

 WScript.Sleep(30000) '30秒待つ ※自動スライドにしているので、全体の秒数待つ、
 '↑おいおいそれでいいのか？、毎回スライド全体の秒数を測って、
 'プログラム修正・・・えっ、まずいでしょ

 oApp.ActivePresentation.Application.Quit  '抜ける パワポ終了
'---------------

とりあえず、自動実行時のタイミングで、次のスライドに移る待ちを０にして、
※連続実行にして、oApp.SlideShowWindows(1).View.Next 次のページをやめて、
全体の秒数、テストでは30秒、待つことにした・・・

なんだかなぁ。
今回も、テスト不足でした。

#VBScript #PowerPointVBA #スライドショー #自動実行 #デバッグ

次回、
Excel VBAの方で、パワポのイベントを取得する、そんな過去記事もあったので、
手前みそのコードから、スライドショーEndのイベントで何かやってみたいと思います。

---

上記のPowerPointスライドショー の 自動実行をプラスして、
ライブで自動説明を実行しました。なんかイマイチで手ごたえがないけど。

実演の例:
下記のように、自動でプレゼンのスライドを三種類、切り替えながら流してみました。

https://youtu.be/cey6C7XXLT8?t=951

https://youtu.be/cey6C7XXLT8?t=1538

https://youtu.be/cey6C7XXLT8?t=360

 Set oApp = Nothing

 'Excelを起動
 WScript.Sleep 500
 Set oApp = CreateObject("Excel.Application")
 oApp.Visible = True '可視にする
 oApp.UserControl = True

 Dim sFileName(4)
 sFileName(1) = "d:\JRA_TEST\20220508\20220508単勝オッズ東京.xlsm"
 sFileName(2) = "d:\JRA_TEST\20220508\20220508単勝オッズ中京.xlsm"
 sFileName(3) = "d:\JRA_TEST\20220508\20220508単勝オッズ新潟.xlsm"

 For n = 1 to 3
    '1.2 ファイルを開く
    oApp.Workbooks.Open sFileName(n)  '場所単位のファイルを開く
    WScript.Sleep 500
    '1.3 マクロの実行
    oApp.RUN "ie_JRA単勝オッズをレース別に複数蓄積する"
    WScript.Sleep 500
    '1.4 ブックを閉じる
    oApp.ActiveWorkbook.Close  'ブックを閉じる
 Next

 '2 Excelを閉じる
 oApp.Quit
 WScript.Sleep 500
 Set oApp = Nothing

'説明スライド再生テスト

 Set oApp = CreateObject("PowerPoint.Application")
 oApp.Visible = True '可視にする

 '時刻の計算
 m = Minute(Time)
 s = Second(Time)

 n = Int(m / 10)  '0,1,2 を分の十の位で
 If n >= 3 Then n = n - 3  

 Dim ppFILE(3)

 ppFILE(0) = "d:\JRA_TEST\20220508\間の説明1.pptx"
 ppFILE(1) = "d:\JRA_TEST\20220508\間の説明2.pptx"
 ppFILE(2) = "d:\JRA_TEST\20220508\間の説明3.pptx"

 oApp.Presentations.Open(ppFILE(n))
 oApp.Left = 474
 oApp.Top = 220

 WScript.Sleep(1000) '2秒待つ ※これが無いと、下の.Runがうまく動作しなかった、なぜ？

 oApp.ActivePresentation.SlideShowSettings.Run  'スライドショーの実行 F5的なヤツ

 '9:45 から 引く
 w = (9 * 60 + 45) - ((m Mod 10) * 60 + s)
 If w < 1 Then w = 1
 For n = 1 To 10 
     WScript.Sleep(w * 100) 'w秒待つ
 Next 

 oApp.ActivePresentation.Application.Quit  '抜ける パワポ終了