【実務・中級編】【中級者】スライド内のすべての「SmartArt」や「グラフ」を、解像度を保ったまま「EMF（拡張メタファイル）」形式の画像に変換して貼り直し、ファイルサイズを劇的に軽量化して別名保存するマクロ – PowerPoint VBA解析バイブル

プレゼンテーションの「重み」を制御せよ：SmartArtとグラフをEMFへ昇華させる極限の最適化術

業務自動化の現場において、PowerPointのマクロを書く人間は二種類に分かれる。単に「動くコード」を書くスクリプトキッドと、オブジェクトのライフサイクルとファイル構造の整合性を理解し、「プロダクションレベルのツール」を設計するエンジニアだ。

君がもし、クライアントに納品したプレゼン資料が「フォントが変わった瞬間にSmartArtが崩れる」「グラフが多すぎてファイルサイズが数百MBに膨れ上がる」「他者の環境で開くとレイアウトが壊れている」といった報告を受けたことがあるなら、君はまだ、PowerPointの「動的オブジェクト」の恐ろしさを理解していない。

本記事では、SmartArtやグラフといった「重く、壊れやすい」オブジェクトを、解像度を一切損なうことなく、軽量かつ堅牢なEMF（拡張メタファイル）へと一括変換し、スライドを「完成された静的芸術」へと作り変える、プロフェッショナルな実装手法を伝授する。

1. なぜ「コピー＆ペースト」では不十分なのか？

一般的な開発者は、`Shape.Copy` して `Shapes.Paste` するだけのコードを書く。しかし、それではプロの仕事とは言えない。理由は3つある。

1.1 レイアウト崩れの連鎖

SmartArtやグラフは、内部的に複雑なXML構造と、アプリケーション側のレンダリングエンジンに依存した動的データを持っている。別のPC、異なるバージョンのOffice、あるいはフォントが欠落した環境で開いた瞬間、それらは「崩壊」する。

1.2 ファイルサイズの肥大化

動的オブジェクトは、それ自体が「計算式」や「データテーブル」を内包している。スライドが100枚になり、グラフが数百個ある場合、ファイルサイズは指数関数的に増大する。

1.3 ベクター形式（EMF）の優位性

ここで登場するのがEMF (Enhanced Metafile)だ。
PNGやJPGのようなラスタ形式（ピクセル）ではなく、EMFはベクター形式である。拡大しても境界線がぼやけず、極めて高い解像度を保ったまま、データ構造を極限まで単純化（静的化）できる。これが、プロが選択すべき「解」である。

2. アーキテクチャ設計：堅牢な変換ロジックの要諦

単に変換するだけでは、バグの温床となる。設計段階で以下の3点を考慮しなければならない。

1. コレクションの反転ループ: `For Each` でシェイプをループしながら `Delete` を行うと、インデックスがずれ、オブジェクトのスキップが発生する。必ず末尾から逆順（Step -1）でループせよ。
2. クリップボードの同期問題: `Copy` 直後に `Paste` を行うと、Windowsのクリップボード処理が追いつかず、エラーが発生することがある。`DoEvents` を挟み、OSに制御を戻す余裕を与えよ。
3. Zオーダー（重なり順）の維持: 元のオブジェクトが消え、新しい画像が貼られたとき、重なり順が変わってしまう。新しいオブジェクトの `ZOrder` を制御するか、元の位置・サイズを厳密に継承せよ。

3. プロダクションコード：EMF一括変換エンジン

以下に、実務に投入可能なレベルまで磨き上げたコードを示す。単なるコピペではなく、コメントから私の設計思想を読み取ってほしい。

Option Explicit

''' <summary>
''' プレゼンテーション内のすべてのSmartArtおよびグラフをEMF形式に変換する。
''' ファイルサイズを軽量化し、環境依存のレイアウト崩れを防止する。
''' </summary>
Public Sub OptimizePresentationToEMF()
    Dim targetPres As Presentation
    Dim targetSlide As Slide
    Dim i As Long
    Dim shp As Shape
    Dim newShp As Shape
    Dim convertedCount As Long
    
    ' 1. 対象プレゼンテーションの確定
    Set targetPres = ActivePresentation
    convertedCount = 0
    
    ' 画面更新の停止（高速化のため。ただしPPTにはExcelのような完全な停止はないが、操作を最小限にする）
    On Error GoTo ErrorHandler
    
    Debug.Print "--- Optimization Started: " & Now & " ---"

    ' 2. スライド単位のループ
    For Each targetSlide In targetPres.Slides
        
        ' 3. 【重要】シェイプのループは「逆順」で行う
        ' 削除が発生するため、前方から回すとインデックスが壊れる
        For i = targetSlide.Shapes.Count To 1 Step -1
            Set shp = targetSlide.Shapes(i)
            
            ' 4. 変換対象の判定（SmartArt または グラフ）
            If IsTargetObject(shp) Then
                
                ' オブジェクトのプロパティを退避
                Dim sLeft As Single: sLeft = shp.Left
                Dim sTop As Single: sTop = shp.Top
                Dim sWidth As Single: sWidth = shp.Width
                Dim sHeight As Single: sHeight = shp.Height
                Dim sZOrder As MsoZOrderRank: sZOrder = shp.ZOrderPosition
                
                ' 5. 変換プロセス
                On Error Resume Next
                shp.Copy
                DoEvents ' クリップボードの処理待ちをOSに許容
                
                ' EMF形式で貼り付け
                Set newShp = targetSlide.Shapes.PasteSpecial(DataType:=ppPasteEMF)
                
                If Err.Number = 0 Then
                    ' 6. 属性の復元（位置、サイズ、重なり順）
                    With newShp
                        .Left = sLeft
                        .Top = sTop
                        .Width = sWidth
                        .Height = sHeight
                        ' 元のオブジェクトと同じ重なり順へ（近似値）
                        ' 注意: Paste直後は最前面に来るため、必要に応じて調整
                    End With
                    
                    ' 元の動的オブジェクトを削除
                    shp.Delete
                    convertedCount = convertedCount + 1
                Else
                    Debug.Print "Error converting shape: " & shp.Name & " - " & Err.Description
                End If
                On Error GoTo ErrorHandler
                
            End If
        Next i
    Next targetSlide

    MsgBox "最適化完了。" & vbCrLf & _
           "変換されたオブジェクト数: " & convertedCount & vbCrLf & _
           "ファイルサイズを保存して確認してください。", vbInformation, "Success"
    
    Exit Sub

ErrorHandler:
    MsgMsgBox "致命的なエラーが発生しました。" & vbCrLf & _
              "Error No: " & Err.Number & vbCrLf & _
              "Description: " & Err.Description, vbCritical, "Critical Error"
End Sub

''' <summary>
''' 変換対象となるオブジェクトかどうかを判定するヘルパー関数
''' </summary>
Private Function IsTargetObject(ByRef shp As Shape) As Boolean
    Select Case shp.Type
        Case msoSmartArt, msoChart
            IsTargetObject = True
        Case msoGroup
            ' グループ化された中にあるSmartArtなどは、
            ' 再帰的に探索するか、グループごと変換する設計が必要
            ' 今回はシンプルにするため、グループ自体は対象外とする
            IsTargetObject = False
        Case Else
            IsTargetObject = False
    End Select
End Function

4. エンジニアとしての高度な考察

このコードを運用に投入するにあたり、君が直面するであろう「次なる課題」について予習しておこう。

4.1 グループ化されたオブジェクトへの対応

上記のコードは、単一の `msoSmartArt` には反応するが、「SmartArtがグループ化されている場合」は検知できない。これを解決するには、`shp.Type = msoGroup` の場合に再帰的に `GroupItems` を走査するロジックを実装する必要がある。しかし、グループ内の個別の要素をEMF化すると、グループとしての整合性が失われるリスクがあるため、実務上は「グループごとコピーしてEMF化する」方が安全な場合が多い。

4.2 メモリ管理と大規模処理

数百枚のスライドを処理する場合、クリップボードを大量に使用するため、メモリ圧迫やクリップボードの競合が起きる可能性がある。極めて大規模な自動化を行う場合は、一時的にファイルを分割して処理するか、`DoEvents` を戦略的に配置し、OSのリソース解放を待つ設計が求められる。

4.3 データベース連携への応用

もし君が、このマクロを「データベースから取得したデータに基づき、自動でグラフを作成し、そのまま納品用PDF/EMF化する」というパイプラインの一部として設計しているなら、「変換の成否」をログとしてDBに書き戻す仕組みを必ず組み込め。自動化において、最大の敵は「失敗したことに気づかず、壊れた資料がクライアントに届くこと」だ。

結論

PowerPoint VBAは、単なる「作業の自動化」の道具ではない。それは、複雑なオブジェクトモデルを制御し、プレゼンテーションという「成果物」の品質をエンジニアリングするための手段である。

「動く」コードを書くだけで満足するな。「堅牢で、美しく、軽量な」コードを書け。それが、伝説的なアーキテクトへの第一歩だ。