【極限の最適化】PowerPoint VBAで「賢く」画像を圧縮する —— 画質とファイルサイズを両立させるエンジニアの思考法
こんにちは。業務自動化の深淵へようこそ。
皆さんは、プレゼンテーションを作成していて「ファイルサイズが肥大化しすぎて、メールで送れない！」「スライドの切り替えが重い！」と頭を抱えたことはありませんか？
一般的な解決策は、PowerPointの標準機能にある「図の圧縮」を使うことです。しかし、あれは少し「乱暴」すぎます。全ての画像を、一律に指定した解像度まで落としてしまうからです。これでは、拡大して見せたい重要な高精細な写真までボヤけてしまい、プレゼンの質を下げてしまいます。
真のプロフェッショナルは、「必要なものは高画質のまま、無駄に巨大な画像だけを狙い撃ちする」というアプローチを取ります。
今日は、中級者への登竜門として、「高解像度な画像のみをスキャンし、閾値（しきいち）を超えたものだけを再エンコードして軽量化する」という、非常に実戦的なツールを構築していきましょう。
ここをマスターすれば、あなたは単なる「マクロ記録係」を卒業し、オブジェクトの性質を操る「エンジニア」へと進化できるはずです。
1. 設計思想：なぜ「一括圧縮」ではいけないのか？
まず、プログラムを書く前に「設計図（アーキテクチャ）」を頭に描きましょう。
通常の圧縮は、全画像に対して `Resolution = 150dpi` のような命令を投げます。しかし、私たちの作るツールは以下の3ステップ・ロジックで動きます。
1. スキャン（Scan）: 全スライドを巡回し、`Shape` オブジェクトの中から「画像（Picture）」だけを抽出する。
2. 判定（Evaluate）: その画像のピクセルサイズ（幅 × 高さ）を計算し、あらかじめ設定した「閾値」を超えているか判定する。
3. 変換（Transform）: 閾値を超えた「重すぎる画像」だけを、一度外部ファイル（JPG）として書き出し、再度読み込み直すことで、データ構造を最適化（ダウンサンプル）する。
この「選択的処理」こそが、パフォーマンスと画質を両立させる極意です。
2. 実装コード：Selective Image Optimizer
それでは、魂を込めたコードを見ていきましょう。このコードは、単に動くだけでなく、エラーハンドリングとメモリへの配慮を組み込んでいます。
Option Explicit
''' <summary>
''' プレゼンテーション内の高解像度画像を特定し、自動的にリサイズ・再圧縮する
''' </summary>
Sub OptimizeHighResImages()
Dim sld As Slide
Dim shp As Shape
Dim targetWidth As Single
Dim targetHeight As Single
Dim pixelThreshold As Long
Dim tempFilePath As String
Dim imgWidth As Long, imgHeight As Long
Dim count As Integer
' --- 設定セクション ---
' 判定基準となるピクセル数 (例: 2000x2000 = 4,000,000)
' これを超える画像は「重すぎる」とみなして圧縮対象にする
pixelThreshold = 4000000
' 一時保存用のパス（デスクトップ等）
tempFilePath = Environ("TEMP") & "\temp_img.jpg"
' ----------------------
count = 0
On Error GoTo ErrorHandler
Debug.Print "--- 最適化プロセス開始 ---"
' 1. 全スライドをループ
For Each sld In ActivePresentation.Slides
' 2. スライド内の全シェイプをループ
' ※ Shapeを削除・置換する場合、後ろからループするのが鉄則（インデックスのズレ防止）
For i = sld.Shapes.Count To 1 Step -1
Set shp = sld.Shapes(i)
' 3. オブジェクトが「画像」であるか判定
If shp.Type = msoPicture Or shp.Type = msoLinkedPicture Then
' 画像のピクセルサイズを近似計算（ポイント単位からピクセルへ）
' VBAのShape.Widthは「ポイント」単位なので、解像度を考慮した計算が必要
' ここでは簡易的に、画像の元々のサイズ（ピクセル）を判定基準とする
imgWidth = shp.Width * 96 / 72 ' ポイントをピクセルに変換(標準96dpi想定)
imgHeight = shp.Height * 96 / 72
' 4. 閾値判定
If (imgWidth * imgHeight) > pixelThreshold Then
Debug.Print "最適化対象発見: Slide " & sld.SlideIndex & " | Size: " & imgWidth & "x" & imgHeight
' --- 変換プロセス ---
' A. 画像を一旦JPGとしてエクスポート（ここで圧縮がかかる）
shp.Export tempFilePath, ppShapeFormatJPG
' B. 元の画像の配置情報を保持
targetWidth = shp.Width
targetHeight = shp.Height
Dim leftPos As Single: leftPos = shp.Left
Dim topPos As Single: topPos = shp.Top
Dim zOrder As Long: zOrder = shp.ZOrderPosition
' C. 古い画像を削除し、新しい画像を挿入
shp.Delete
Dim newShp As Shape
Set newShp = sld.Shapes.AddPicture(FileName:=tempFilePath, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=leftPos, _
Top:=topPos, _
Width:=targetWidth, _
Height:=targetHeight)
' D. 重なり順を復元
newShp.ZOrder msoBringToFront ' 簡易的に最前面へ（本来はより緻密な制御が可能）
count = count + 1
End If
End If
Next i
Next sld
' 後処理
If Dir(tempFilePath) <> "" Then Kill tempFilePath
MsgBox "完了しました！" & vbCrLf & "最適化された画像数: " & count & " 枚", vbInformation, "最適化完了"
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました: " & Err.Description, vbCritical, "実行エラー"
If Dir(tempFilePath) <> "" Then Kill tempFilePath
End Sub3. プロフェッショナルの解説：ここがエンジニアの視点
コードをただ眺めるだけでは、あなたの力にはなりません。なぜこのように書いたのか、その「意図」を理解してください。
① なぜ `For i = sld.Shapes.Count To 1 Step -1` なのか？
これが最も重要なポイントです。
プログラミング初学者がよく陥る罠が、「コレクション（集まり）をループしながら、その中身を削除すること」です。
例えば、1番目、2番目、3番目の画像があるとします。
1. 1番目を削除すると、元々2番目だったものが「新しい1番目」に繰り上がります。
2. 次のループで「2番目」を見に行くと、元々の3番目を見てしまい、2番目を飛ばしてしまうのです。
これを防ぐには、「後ろ（インデックスの大きい方）から前に向かってループする」のが定石です。これにより、削除によってインデックスがズレても、まだ見ていない要素には影響を与えません。
② `shp.Export` による「再エンコード」の魔法
VBAには「画像を直接リサイズしてメモリ上のピクセルデータを書き換える」という直接的なコマンドはありません。
そこで、私たちは「一度画像として書き出す（Export）」というテクニックを使います。`Export` メソッドでJPG形式を指定すると、PowerPointは内部的に画像を圧縮してファイルに書き出します。それを再び `AddPicture` で読み込み直すことで、実質的に「圧縮された画像」に差し替えているのです。
③ ポイント(pt)とピクセル(px)の壁
PowerPoint内部では、サイズは「ポイント」という単位で管理されています。しかし、私たちが「解像度が高い」と判断する基準は「ピクセル」ですよね。
コード内の `shp.Width * 96 / 72` という計算は、ポイントをピクセルに変換するためのマジックナンバーです。これを知っているだけで、あなたの作るツールの精度は劇的に上がります。
4. さらなる高みへ：陥りやすいエラーと対策
このツールを運用する上で、以下の点に注意してください。
- メモリの解放: `tempFilePath`（一時ファイル）は、処理が終わったら必ず `Kill` コマンドで削除しましょう。これを忘れると、ユーザーのPCにゴミファイルが溜まり続けてしまいます。
- スライドマスターの存在: 今回のコードは「スライド上の図形」のみを対象としています。スライドマスター（背景のデザイン）に含まれる画像は、`ActivePresentation.SlideMaster` を別途ループさせる必要があります。
- 実行速度: 画像が数百枚ある場合、処理には時間がかかります。`Application.ScreenUpdating = False`（※PowerPointでは直接使えない場合が多いですが、他のOffice製品では必須）のような、描画停止の概念を持つことが、大規模開発では重要になります。
最後に
いかがでしたでしょうか？
「マクロの記録」ボタンを押すだけでは決して辿り着けない、「オブジェクトをどう操作し、どう制御するか」という設計の思考。これこそが、エンジニアとしての真の価値です。
このコードは一つの完成形ではありません。閾値を調整したり、PNG形式に対応させたり、さらに進化させていってください。その試行錯誤の先にこそ、真の技術が宿ります。
さあ、次はあなたの手で、世界で最も効率的な自動化ツールを作り上げてください。応援していますよ！
