【テクニカル・上級編】【中級者】複数のPPTXファイルを一括で開き、各スライドの「更新日時」を比較して、最新のスライドだけを集約した「最新版マージプレゼンテーション」を自動生成・保存するマクロ – PowerPoint VBA解析バイブル

PowerPoint VBA

2026.11.13

構成情報のエントロピーを制御せよ：スライド単位のタイムスタンプ比較による「最新版マージ」の極致

構成情報のエントロピーを制御せよ：スライド単位のタイムスタンプ比較による「最新版マージ」の極致

分散開発における最大の敵は、コードの衝突（Conflict）ではない。プレゼンテーションにおける「情報の断片化（Fragmentation）」だ。

複数のメンバーが、同一の構成案に基づき、個別のファイルとしてスライドを更新していく。プロジェクトが進行するにつれ、各ファイルには「最新のスライド」と「既に陳腐化したスライド」が混在することになる。これらを単純に結合するだけのスクリプトは、情報のゴミ溜め（Data Swamp）を作り出す。

我々エンジニアに求められるのは、各スライドの「真実（Truth）」、すなわち最終更新日時を正確に検出し、それに基づき、最新の構成要素のみを抽出して再構築する決定論的なアーキテクチャである。

本稿では、単なるマクロの書き方ではない。PowerPointオブジェクトモデルのメモリ特性、Windows OSレベルのファイルハンドリング、そして大規模運用に耐えうる堅牢なオブジェクトライフサイクル管理について、その深淵に触れる。

1. アーキテクチャ設計：メタデータの所在を定義する

まず、技術的な前提条件を整理しておく。
`.pptx` ファイルは実態としてZIP圧縮されたXML集合体である。OSレベルのファイル更新日時（`FileDateTime`）は「ファイル全体」に対してのみ存在し、「スライド単位」の更新日時をOSが保持しているわけではない。

したがって、本ソリューションを実現するには、「各スライドのメタデータをどこに格納するか」という設計思想が不可欠である。

本稿では、以下の戦略を採用する。
1. メタデータ・アンカー: 各スライドの隠し領域（あるいは特定の命名規則を持つShape）に、更新日時を保持させる。
2. スキャン・フェーズ: `FileSystemObject` を用い、対象ディレクトリ内の全ファイルを列挙し、各スライドのメタデータをメモリ上の辞書（`Scripting.Dictionary`）に集約する。
3. マージ・フェーズ: 最も新しいタイムスタンプを持つスライドを特定し、新しいプレゼンテーションへ `InsertFromFile` ではなく、オブジェクトのクローン（スライドのコピー）を用いて整合性を保ちながら統合する。

2. 極限のコード実装：Robust Merge Engine

以下に、シニアエンジニアが実戦投入するための、メモリ管理を徹底した実装例を示す。

' ==============================================================================
' Module: SlideVersionMaster
' Description: 複数ファイルから最新スライドのみを抽出・統合するエンジン
' Author: Legendary Chief Architect
' ==============================================================================

Option Explicit

' Windows APIを利用したファイル属性取得の準備（必要に応じて拡張）
' 今回は安定性を重視し、FileSystemObjectとPowerPoint Object Modelを主軸とする
Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long

' 定数定義
Private Const METADATA_SHAPE_NAME As String = "_SlideUpdateTimestamp"

''' <summary>
''' メインルーチン：最新版マージプレゼンテーションを生成する
''' </summary>
Public Sub ExecuteLatestSlideMerge()
    Dim targetFolder As String
    Dim fileList As Collection
    Dim dictLatestSlides As Object ' Scripting.Dictionary
    Dim mainPres As Presentation
    Dim sourcePres As Presentation
    Dim slideIdx As Integer
    Dim filePath As Variant
    
    ' --- 1. 初期化・環境準備 ---
    On Error GoTo ErrorHandler
    
    ' ターゲットフォルダの選択（実運用では引数や設定ファイルから取得すべき）
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then targetFolder = .SelectedItems(1) Else Exit Sub
    End With
    
    Set dictLatestSlides = CreateObject("Scripting.Dictionary")
    Set fileList = New Collection
    
    ' --- 2. ファイル列挙 ---
    ' FileSystemObjectを用いて、PPTXファイルのみを抽出
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim folder As Object
    Set folder = fso.GetFolder(targetFolder)
    
    For Each filePath In folder.Files
        If LCase(fso.GetExtensionName(filePath.Name)) = "pptx" Then
            fileList.Add filePath.Path
        End If
    Next

    ' --- 3. スキャン・フェーズ：各スライドの最新タイムスタンプを特定 ---
    ' メモリ効率を考え、Presentationオブジェクトの生存期間を最小化する
    For Each filePath In fileList
        Set sourcePres = Presentations.Open(filePath, WithWindow:=msoFalse)
        
        For slideIdx = 1 To sourcePres.Slides.Count
            Dim currentTimestamp As Double
            currentTimestamp = GetSlideTimestamp(sourcePres.Slides(slideIdx))
            
            ' 辞書のキーを "SlideIndex_Identifier"（スライド構成が同一であることを前提とする）とする
            ' ここでは簡易的に、各スライドの「構成上の位置」をキーとして比較
            Dim slideKey As String
            slideKey = CStr(slideIdx)
            
            If Not dictLatestSlides.Exists(slideKey) Then
                dictLatestSlides.Add slideKey, Array(currentTimestamp, filePath, slideIdx)
            Else
                ' 既存の記録より新しいタイムスタンプがあれば更新
                If currentTimestamp > dictLatestSlides(slideKey)(0) Then
                    dictLatestSlides(slideKey) = Array(currentTimestamp, filePath, slideIdx)
                End If
            End If
        Next
        
        ' 重要：オブジェクトの明示的解放
        ' PowerPointのCOMオブジェクトは、Nothingを代入するだけでは不十分な場合がある
        ' Closed状態を確認し、確実にハンドルを解放する
        sourcePres.Close
        Set sourcePres = Nothing
    Next

    ' --- 4. マージ・フェーズ：最新スライドの構築 ---
    Set mainPres = Presentations.Add
    
    ' 辞書をソートしてスライド順に挿入（Key: SlideIndex）
    Dim sortedKeys As Variant
    sortedKeys = SortDictionaryKeys(dictLatestSlides)
    
    Dim k As Variant
    For Each k In sortedKeys
        Dim data As Variant
        data = dictLatestSlides(k)
        
        ' 最新のファイルを開いてスライドをコピー
        Set sourcePres = Presentations.Open(data(1), WithWindow:=msoFalse)
        sourcePres.Slides(data(2)).Copy
        
        ' 新しいプレゼンテーションの末尾に貼り付け
        mainPres.Slides.Paste (mainPres.Slides.Count + 1)
        
        sourcePres.Close
        Set sourcePres = Nothing
        
        ' メモリ圧迫を防ぐためのDoEvents
        DoEvents
    Next

    MsgBox "マージが完了しました。最新版プレゼンテーションを生成しました。", vbInformation
    Exit Sub

ErrorHandler:
    MsgCaseErr Err.Number, Err.Description
    If Not sourcePres Is Nothing Then sourcePres.Close
    Set sourcePres = Nothing
End Sub

''' <summary>
''' スライドに埋め込まれたメタデータ（Shape）からタイムスタンプを取得する
''' </summary>
Private Function GetSlideTimestamp(targetSlide As Slide) As Double
    On Error Resume Next
    Dim shp As Shape
    Set shp = targetSlide.Shapes(METADATA_SHAPE_NAME)
    
    If Not shp Is Nothing Then
        ' ShapeのTextFrameにシリアル値、または日付文字列が格納されている前提
        GetSlideTimestamp = CDbl(shp.TextFrame.TextRange.Text)
    Else
        ' メタデータがない場合は、極めて古い値（0）を返す
        GetSlideTimestamp = 0
    End If
    On Error GoTo 0
End Function

''' <summary>
''' Dictionaryのキーを数値順にソートする（簡易実装）
''' </summary>
Private Function SortDictionaryKeys(dict As Object) As Variant
    ' 実際の実装では、QuickSort等のアルゴリズムを適用すべき
    ' ここでは簡略化のため、キーを取得して数値変換ソートを行うロジックを想定
    Dim arr() As Variant
    Dim i As Long, j As Long, temp As Variant
    Dim keys As Variant
    
    keys = dict.Keys
    ReDim arr(LBound(keys) To UBound(keys))
    For i = LBound(keys) To UBound(keys)
        arr(i) = CLng(keys(i))
    Next
    
    ' バブルソート（小規模なスライド構成であれば十分なパフォーマンス）
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(i) > arr(j) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next
    Next
    SortDictionaryKeys = arr
End Function

Private Sub CaseMsgErr(num As Long, desc As String)
    MsgBox "Critical Error [" & num & "]: " & desc, vbCritical
End Sub

3. 伝説的アーキテクトの知見：パフォーマンスと堅牢性の極意

このコードを単なる「動くスクリプト」から「システム」へと昇華させるために、以下の3点を深く理解せよ。

① オブジェクトのライフサイクルとメモリリーク

VBAにおける `Set obj = Nothing` は、単なるポインタの初期化に過ぎない。PowerPointのような巨大なアプリケーションでは、COM参照カウントが適切に減少しない限り、プロセスがメモリ上に居座り続ける（Ghost Process）。
特に、ループ内で `Presentations.Open` を繰り返す場合、`sourcePres.Close` を呼び出した直後に `Set sourcePres = Nothing` を実行し、さらに `DoEvents` を挟むことで、OSのスケジューラに制御を戻し、リソース解放の猶予を与えることが不可欠である。

② メタデータの「真実性」をどう担保するか

本実装では、スライド内に隠しShape（`_SlideUpdateTimestamp`）を配置することを前提としている。
実務においては、スライド作成時に以下の処理を強制する仕組みを併設すべきである。

スライドの構成要素が変わるたびに、`OnSlideChange` イベント（あるいはアドイン経由）で、現在の `Now` を `CDbl` 形式で隠しShapeに書き込む。
これにより、ファイル全体の更新日時ではなく、「そのスライドが最後に論理的に編集された瞬間」を捕捉できる。これが、真のバージョン管理である。

③ スケールへの配慮：InsertFromFile vs Copy/Paste

`Slides.InsertFromFile` は高速だが、マスターのスライドレイアウトやテーマの不整合を引き起こしやすい。
一方、`Slide.Copy` および `Slides.Paste` は、クリップボードを経由するため、オブジェクトのプロパティ（アニメーション、リンク、配置情報）をより忠実に再現できる。
大規模なプレゼンテーション（数百スライド）を扱う場合、クリップボードの負荷がボトルネックとなるため、その際は `XML` レベルでのスライド・クラスタの操作、あるいは `Open XML SDK` を用いたバックエンド処理への移行を検討せよ。

結論

自動化エンジニアの仕事は、コードを書くことではない。「不確実性を排除すること」である。
複数のソースから最新のパーツを組み上げるプロセスにおいて、タイムスタンプという「唯一の指標」に基づいた決定論的なロジックを実装することで、初めて人間は「どのファイルが最新か」という低次な思考から解放される。

このアーキテクチャを、貴殿のレガシーなワークフローに組み込み、情報の秩序を取り戻してほしい。