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

スポンサーリンク
スポンサーリンク

バージョン管理の混沌を制する:最新スライド自動集約エンジンの設計と実装

プロジェクトが大規模化し、複数のメンバーが並行して同じ構成のプレゼンテーションを更新し始めたとき、現場には必ず「どれが最新の資料か分からない」という混沌(カオス)が訪れる。

「最新_v2_修正済_final.pptx」といったファイル名が乱立する光景は、エンジニアリングの敗北を意味する。我々が目指すべきは、ファイル名に頼るのではなく、メタデータ(更新日時)に基づいた論理的な自動統合である。

本記事では、単なる「スライドの結合」ではない。各スライドの構成を維持しつつ、ファイルシステムから最新のタイムスタンプを読み取り、最も「新しい」情報を自動的に選別してマージする、堅牢なプロフェッショナル・マクロの設計思想を伝授する。

1. アーキテクチャ設計:初心者が陥る「3つの罠」

実装に入る前に、設計思想を整理しておく。多くの開発者が以下の罠にハマり、本番環境でコードをクラッシュさせる。

罠1:オブジェクトのライフサイクル管理の欠如

PowerPoint VBAにおいて、`Presentations.Open` で開いたオブジェクトを適切に `Close` し、さらに `Set obj = Nothing` でメモリを解放しない場合、メモリリークが発生する。大量のファイル(数十〜数百)を処理する場合、ExcelやPowerPoint自体が「応答なし」に陥る原因となる。

罠2:スライド更新日時の誤解

実は、PowerPointの「スライド単体」の更新日時をVBAから直接取得するプロパティは存在しない。スライドの更新情報はXML構造の奥深くに隠されている。実務的な解決策としては、「ファイル全体の最終更新日時」をスライドの世代管理のインデックスとして利用する設計が、最も低コストかつ高精度である。

罠3:スライド挿入メソッドの選択ミス

`InsertFromFile` は高速だが、テーマ(デザイン)やマスターのスライドが崩れるリスクがある。プロフェッショナルなツールとしては、書式を保持するために `Copy` & `Paste` を、あるいはマスターを再適用する制御が必要になる。

2. 実装戦略:Dictionaryを用いた「勝者選別」アルゴリズム

今回の設計では、以下のステップを踏む。

1. スキャン・フェーズ: 指定フォルダ内の全 `.pptx` ファイルを走査し、`FileSystemObject` を用いて「ファイル名」「更新日時」「スライド数」をメモリ上の `Dictionary` オブジェクトに格納する。
2. 判定・フェーズ: 各スライドインデックス(1枚目、2枚目…)に対して、最も更新日時が新しいファイルがどれかを特定する。
3. 構築・フェーズ: 新規プレゼンテーションを作成し、特定された「勝者(最新ファイル)」からスライドを順番にコピーして集約する。

3. プロダクション・コード:最新版マージ・エンジン

以下のコードは、単なるコピペ用ではない。エラーハンドリング、メモリ管理、そして拡張性を考慮した「プロダクション・グレード」の設計である。

' ======================================================================================
' Module: PresentationMerger
' Description: 複数ファイルから最新のスライドを抽出して統合する
' Author: Chief Architect
' ======================================================================================

Option Explicit

' 参照設定: Microsoft Scripting Runtime (Dictionary用)
' 参照設定: Microsoft FileSystemObject 65 もしくは FSOを使用

Sub MergeLatestSlides()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim targetFolder As String
    Dim folderPath As String
    
    ' --- 設定領域 ---
    ' 処理対象のフォルダパスを指定(末尾のバックスラッシュは自動制御)
    folderPath = "C:\Your\Project\Path\Here\" 
    ' ----------------
    
    If Not fso.FolderExists(folderPath) Then
        MsgBox "指定されたフォルダが存在しません。", vbCritical
        Exit Sub
    End If

    ' 1. ファイル情報の収集
    Dim fileList As Object ' Collection to store file info
    Set fileList = CollectFileMetadata(fso, folderPath)
    
    If fileList.Count = 0 Then
        MsgBox "対象となるPPTXファイルが見つかりませんでした。", vbExclamation
        Exit Sub
    End If

    ' 2. スライドインデックスごとの「最新ファイル」を判定
    ' Dictionary Key: SlideIndex (Integer), Value: FilePath (String)
    Dim winnerMap As Object
    Set winnerMap = DetermineWinningFiles(fileList)

    ' 3. マージ実行
    ExecuteMerge winnerMap, folderPath

    MsgBox "マージが完了しました。最新版プレゼンテーションを確認してください。", vbInformation
End Sub

' --- メタデータ収集関数 ---
Private Function CollectFileMetadata(fso As Object, path As String) As Object
    Dim files As Object
    Set files = CreateObject("Scripting.Dictionary")
    
    Dim folder As Object
    Set folder = fso.GetFolder(path)
    
    Dim file As Object
    Dim pptApp As Object
    Set pptApp = Application ' 現在のインスタンスを利用
    
    Dim pres As Object
    
    For Each file In folder.Files
        If LCase(fso.GetExtensionName(file.Name)) = "pptx" And Left(file.Name, 2) <> "~$" Then
            ' ファイルを開いてスライド数を取得(バックグラウンドで開く)
            On Error Resume Next
            Set pres = pptApp.Presentations.Open(file.Path, ReadOnly:=msoTrue, WithWindow:=msoFalse)
            If Err.Number = 0 Then
                ' Key: FilePath, Value: Array(LastModified, SlideCount)
                files.Add file.Path, Array(file.DateLastModified, pres.Slides.Count)
                pres.Close
            End If
            On Error GoTo 0
        End If
    Next file
    
    Set CollectFileMetadata = files
End Function

' --- 勝者選別ロジック ---
Private Function DetermineWinningFiles(fileList As Object) As Object
    Dim winnerMap As Object
    Set winnerMap = CreateObject("Scripting.Dictionary")
    
    Dim filePath As Variant
    Dim slideIdx As Integer
    Dim currentFileDate As Date
    Dim bestFileForIdx As String
    Dim bestDateForIdx As Date
    
    ' 各ファイルについてループ
    For Each filePath In fileList.Keys
        currentFileDate = fileList(filePath)(0)
        Dim slideCount As Integer
        slideCount = fileList(filePath)(1)
        
        ' 各スライドに対して、そのインデックスの「最新」を更新していく
        For slideIdx = 1 To slideCount
            If Not winnerMap.Exists(slideIdx) Then
                ' 初めて見るスライドインデックスなら登録
                winnerMap.Add slideIdx, filePath
            Else
                ' 既存の勝者と比較
                bestFileForIdx = winnerMap(slideIdx)
                bestDateForIdx = fileList(bestFileForIdx)(0)
                
                If currentFileDate > bestDateForIdx Then
                    ' 今見ているファイルの方が新しい場合、入れ替える
                    winnerMap(slideIdx) = filePath
                End If
            End If
        Next slideIdx
    Next filePath
    
    Set DetermineWinningFiles = winnerMap
End Function

' --- マージ実行関数 ---
Private Sub ExecuteMerge(winnerMap As Object, folderPath As String)
    Dim masterPres As Presentation
    Set masterPres = Application.Presentations.Add
    
    Dim slideIdx As Variant
    Dim sourcePath As String
    Dim sourcePres As Presentation
    Dim targetSlide As Slide
    
    ' スライドインデックス順にソートして処理(Dictionaryは順不同なため)
    ' 本来はインデックスをソートするロジックが必要だが、ここでは簡略化のため
    ' 昇順でループを回すための配列変換を行う
    Dim sortedIndices As Object
    Set sortedIndices = SortDictionaryKeys(winnerMap)
    
    On Error GoTo ErrorHandler
    
    For Each slideIdx In sortedIndices
        sourcePath = winnerMap(slideIdx)
        
        ' 最新ファイルを開く
        Set sourcePres = Application.Presentations.Open(sourcePath, ReadOnly:=msoTrue, WithWindow:=msoFalse)
        
        ' スライドをコピーして貼り付け
        ' Copy/Pasteを使用することで、書式とマスターの整合性を高める
        sourcePres.Slides(slideIdx).Copy
        masterPres.Slides.Paste
        
        ' 貼り付けたスライドは末尾に追加されるため、位置を微調整する必要がある場合もあるが
        ' Pasteメソッドは通常末尾に追加される。
        
        sourcePres.Close
        Set sourcePres = Nothing
    Next slideIdx

    ' 保存
    Dim savePath As String
    savePath = folderPath & "Merged_Latest_Version_" & Format(Now, "yyyymmdd_hhnnss") & ".pptx"
    masterPres.SaveAs savePath
    
    Exit Sub

ErrorHandler:
    MsgBox "マージ中にエラーが発生しました: " & Err.Description, vbCritical
    If Not sourcePres Is Nothing Then sourcePres.Close
End Sub

' --- 補助関数: Dictionaryのキーを昇順にソート ---
Private Function SortDictionaryKeys(dict As Object) As Object
    Dim keys As Variant
    keys = dict.Keys
    
    ' バブルソート(要素数が少ないことが前提のためシンプルに実装)
    Dim i As Long, j As Long, temp As Variant
    For i = LBound(keys) To UBound(keys) - 1
        For j = i + 1 To UBound(keys)
            If keys(i) > keys(j) Then
                temp = keys(i)
                keys(i) = keys(j)
                keys(j) = temp
            End If
        Next j
    Next i
    
    ' ソート済みキーを新しいDictionaryに格納
    Dim sortedDict As Object
    Set sortedDict = CreateObject("Scripting.Dictionary")
    Dim k As Variant
    For Each k In keys
        sortedDict.Add k, ""
    Next k
    
    Set SortDictionaryKeys = sortedDict
End Function

4. エンジニアリング・ノート:なぜこの設計なのか

なぜ `Dictionary` を使うのか?

`Collection` よりも `Dictionary` を選んだ理由は、「キーによる高速な検索」と「存在確認(Existsメソッド)」にあります。スライドインデックスをキーにすることで、「このスライド番号の最新版は既に保持しているか?」という判定を $O(1)$ の計算量で実現しています。

メモリ管理の極意

コード内で `sourcePres.Close` を実行した後、即座に `Set sourcePres = Nothing` を行っています。これは、ガベージコレクションが走る前に、明示的に参照を断ち切るためです。大規模なループ内でのオブジェクト解放を怠ると、VBAのスタック領域が枯渇し、予期せぬ挙動を引き起こします。

堅牢性を高めるための「ソート」

`Dictionary` のキーは挿入順に依存するため、そのままループを回すとスライドが「1枚目、3枚目、2枚目…」とバラバラに結合されるリスクがあります。`SortDictionaryKeys` 関数を実装することで、必ずスライド番号順に結合されることを保証しています。

5. まとめ:実務への適用に向けて

このツールは、単なる自動化スクリプトではありません。「データの信頼性(データ・インテグリティ)」を確保するためのシステムです。

導入にあたっては、以下の運用ルールをセットで検討してください。
1. ファイル保存の規律: 編集者は必ずファイルを保存して閉じること(更新日時を正しく記録するため)。
2. フォルダの分離: 実行用のフォルダと、成果物(Merged_…)の保存先を分ける設計にすること。

これらをマスターすれば、あなたは「ただのマクロ使い」から、「業務プロセスを再設計できるアーキテクト」へと昇華できるはずだ。

タイトルとURLをコピーしました