PowerPoint VBAを掌握する極限の知見：`CreateVideo`の非同期地獄を制覇する堅牢なポーリング実装
業務自動化の現場において、PowerPoint資料を動画（MP4）へエクスポートする自動化ニーズは非常に高い。営業資料の動画化、サイネージ用コンテンツの量産、ウェビナーの自動生成など、これらをVBAで一気通貫できればどれほど工数が削減できることか。
しかし、ここで開発者の前に立ち塞がるのが「非同期処理の壁」だ。
PowerPointの `Presentation.CreateVideo` メソッドは、呼び出した瞬間にバックグラウンドで動画エンコードを開始し、VBAの実行スレッドをブロックせずに制御を即座に返してしまう。何も考えずにこのメソッドを実行すると、VBAは次の行へ進み、最悪の場合はファイル保存やアプリケーション終了が引き金となってエンコード中のプロセスがクラッシュする。
今回は、この非同期処理を完璧に手なずけ、極限まで堅牢な「完了待ちポーリング（Polling）」を実装するための知見を共有する。
—
1. なぜ「単なる `Sleep`」や「`DoEvents`ループ」では破綻するのか？
多くの初学者がやりがちなアンチパターンがこれだ。
‘ 【絶対に行ってはいけないアンチパターンの例】
ActivePresentation.CreateVideo “C:\Output\sample.mp4”
‘ 終わっただろうと勝手に予測して待つ
Application.Wait Now + TimeValue(“00:01:00”)
あるいは、`DoEvents` を入れた無限ループ。
ActivePresentation.CreateVideo “C:\Output\sample.mp4”
Do
DoEvents
Loop ‘ 終わる条件がない、または例外処理がない
これらがなぜ実務で通用しないのか。理由は3つある。
1. スライド枚数や解像度によってエンコード時間は変動するため、「1分待てばいい」というハードコードは必ず破綻する。
2. `CreateVideoStatus` のステータス値を見ずにループを回すと、CPU使用率が100%に張り付く（CPUの無駄遣い＝サーマルスロットリングの原因）。
3. エンコード中にユーザーがPowerPointを操作したり、予期せぬエラー（ディスク容量不足やファイルロック）が発生した場合のハンドリングが完全に抜け落ちている。
プロのエンジニアであれば、「状態を監視し、適切なインターバルを挟み、タイムアウトとエラーハンドリングを完備したステートマシン」を構築しなければならない。
—
2. オブジェクトモデルの核心：`CreateVideoStatus` を読み解く
動画生成の進捗は、`Presentation` オブジェクトの `CreateVideoStatus` プロパティを通じて取得できる。このプロパティが返すのは、`PpMediaTaskStatus` 列挙体だ。
| ステータス値 | 意味 | 対策 |
| :— | :— | :— |
| `ppMediaTaskStatusInProgress` (0) | 処理中 | 待機を継続 |
| `ppMediaTaskStatusQueued` (1) | キュー待ち | 待機を継続 |
| `ppMediaTaskStatusDone` (2) | 完了 | ループを抜け、次の処理へ |
| `ppMediaTaskStatusFailed` (3) | 失敗 | エラーとして処理を中断 |
| `ppMediaTaskStatusNone` (4) | 未実行 / 該当なし | 初期状態・または未発火 |
我々が書くべきコードは、このステータスが `Done` になるまで優雅に待ち、`Failed` になったら即座に検知してログを残す、洗練された監視ループである。
—
3. 【プロダクションコード】堅牢な非同期監視・動画エクスポートプロシージャ
実務の現場でそのままコピー＆ペーストして使える、エラーハンドリングとCPU負荷対策（`Application.Wait` による適切なインターバル）を組み込んだ完成版のコードだ。
Option Explicit
‘ メインのエントリーポイント
Sub ExportPresentationToVideo_Production()
Dim targetPres As Presentation
Dim outputPath As String
Dim isSuccess As Boolean
‘ 対象プレゼンテーション（ここではアクティブなプレゼン）
Set targetPres = ActivePresentation
‘ 出力パスの定義（デスクトップに出力）
outputPath = CreateObject(“WScript.Shell”).SpecialFolders(“Desktop”) & “\AutomatedVideo_” & Format(Now, “yyyymmdd_hhmmss”) & “.mp4”
‘ 動画書き出しの実行と完了監視
isSuccess = GenerateVideoWithPolling(targetPres, outputPath, 600) ‘ タイムアウトを10分（600秒）に設定
If isSuccess Then
MsgBox “動画の生成に成功しました。” & vbCrLf & “保存先: ” & outputPath, vbInformation, “処理完了”
Else
MsgBox “動画の生成に失敗またはタイムアウトしました。ログを確認してください。”, vbCritical, “エラー”
End If
End Sub
‘================================================================================
‘ 職人技が光る：非同期ステータス監視（ポーリング）コア関数
‘================================================================================
Private Function GenerateVideoWithPolling(pres As Presentation, filePath As String, maxWaitSeconds As Long) As Boolean
Dim startTime As Double
Dim currentStatus As PpMediaTaskStatus
Dim pollInterval As Double
‘ ポーリング間隔（例: 2秒に1回チェック。CPU負荷を完全に抑制）
pollInterval = 2 / 86400# ‘ 2秒をExcel/VBAのシリアル値に変換
‘ 既存の同名ファイルがあれば削除（上書き時のロックを防ぐ）
On Error Resume Next
If Dir(filePath) <> “” Then Kill filePath
On Error GoTo 0
‘ — 非同期タスクのキック —
‘ 引数: FileName, UseTimingsAndNarrations, DefaultSlideDuration, Resolution, FramesPerSecond
pres.CreateVideo FileName:=filePath, _
UseTimingsAndNarrations:=True, _
DefaultSlideDuration:=5, _
Resolution:=1080, _
FramesPerSecond:=30
‘ キック直後はステータスが反映されるまでにわずかなタイムラグがあるため、1秒待機
Application.Wait Now + TimeValue(“00:00:01”)
startTime = Timer
‘ — ポーリングループの開始 —
Do
‘ ステータスを取得
currentStatus = pres.CreateVideoStatus
Select Case currentStatus
Case ppMediaTaskStatusDone
‘ 成功終了
GenerateVideoWithPolling = True
Exit Function
Case ppMediaTaskStatusFailed
‘ レンダリング失敗
Debug.Print “[Error] 動画生成エンジンがエラーを返しました。”
GenerateVideoWithPolling = False
Exit Function
Case ppMediaTaskStatusInProgress, ppMediaTaskStatusQueued
‘ まだ処理中の場合、タイムアウトチェックを行う
If (Timer – startTime) > maxWaitSeconds Then
Debug.Print “[Error] 動画生成がタイムアウトしました（制限時間: ” & maxWaitSeconds & “秒）。”
‘ 暴走したタスクを止める手立てはないため、処理断念のフラグを立てる
GenerateVideoWithPolling = False
Exit Function
End If
‘ CPU負荷を下げるため、指定秒数だけ処理を一時停止しつつ、OSに制御を返す
Application.Wait Now + pollInterval
DoEvents ‘ UIのフリーズを防ぎ、OSからのイベントを処理
Case Else
‘ 予期せぬステータス
Debug.Print “[Warning] 未知のステータスを検知しました: ” & currentStatus
Application.Wait Now + pollInterval
DoEvents
End Select
Loop
End Function
—
4. チーフアーキテクトからの実践的アドバイス（ファイル・DB連携時の注意点）
この自動化をさらに進め、RPAやデータベース（Access / SQL Server / kintone等）と連携させる場合の「現場の知恵」を授けよう。
1. ファイルロックの罠
動画ファイル生成直後のファイルシステムは、OSのインデクサやセキュリティソフトがファイルを掴んでいることがある。VBA側で「生成完了」を検知した直後に別のプログラム（メール添付やクラウドストレージへのアップロード）を走らせると、「ファイルが使用中です」という致命的なエラーが発生する。
- 対策: 完了検知後、さらに `Open filePath For Binary Access Read As #1` を試行し、排他制御エラーが出なくなるまで数十ミリ秒単位のウェイトを挟む堅牢なラッパー関数を用意すること。
2. PowerPointの裏画面（Headless）実行の危険性
バックグラウンドでPowerPointを完全に非表示（`Visible = msoFalse`）のまま動画生成を行うと、GPUのハードウェアアクセラレーションやDirectXの描画コンテキストが正常に初期化されず、`ppMediaTaskStatusFailed` にすらならず沈黙（フリーズ）する現象が一部の環境で確認されている。
- 対策: 動画生成時は、PowerPointウィンドウは最小化程度にとどめ、完全に非表示（`Visible = False`）にすることは避けるのが無難だ。
—
総括
VBAにおける非同期処理の制御は、一見すると泥臭いループ処理に見えるかもしれない。しかし、「状態を正しく監視し、適切なインターバルでCPUを労わり、タイムアウトと例外をハンドリングする」というエンジニアリングの基本原則を忠実に守ることで、企業の基幹業務を支えるタフな自動化システムへと昇華させることができる。
「動けばいい」のコードを卒業し、現場で絶対に止まらないロジスティクスをあなたの手で構築してほしい。
