ようこそ！日々のプレゼンテーション作成や自動化ツールの開発、お疲れ様です。
企画書や提案書に高解像度のスクリーンショットや現場の写真を何十枚も貼り付けた結果、「ファイルサイズが300MBを超えてしまった…」「社内の共有フォルダや持ち運び用のUSBメモリに保存しようとしたら、容量不足エラーで保存に失敗してデータが飛んだ…」なんて苦い経験はありませんか？
PowerPoint VBAの基本を覚えた皆さんが次に目指すべきは、「エラーが起きてから止まるマクロ」ではなく「実行環境を自ら察知して柔軟に対応するインテリジェントなマクロ」です。
今回は、Windows OSの機能（Windows API）を直接呼び出して「保存先ストレージのリアルタイムな空き容量」を取得し、もし容量が足りなければ「プレゼンテーション内の全画像を自動で最適化・圧縮して極限までダイエットさせてから保存する」という、プロ仕様のスマート保存マクロを作成してみましょう。
ここをクリアすれば、PowerPoint VBAの基本だけでなく、OS連携を含めた上級者への階段を一気に駆け上がることができますよ！
—
1. 全体像をイメージしよう（アーキテクチャ図解）
まずは、プログラムがどのような順番で判断を下すのか、全体の流れを図解で掴んでおきましょう。
[保存処理の開始]
│
▼
【ステップ 1】保存先パスの空き容量をチェック
│
├─ (十分な空きがある) ─────► そのまま通常保存して完了！
│
▼ (空きが危険水準・不足)
【ステップ 2】プレゼンテーションの緊急軽量化モード発動
│ ・全スライド内の画像シェイプ（グループ化内も含む）を走査
│ ・PowerPointの最適化エンジン(ExecuteMso)を安全にキック
▼
【ステップ 3】スリム化した状態で安全に保存
│
[処理完了：空き容量不足によるクラッシュを完全回避]
このように、マクロに「眼（状況判断機能）」を持たせることで、ユーザーをストレージ枯渇エラーの恐怖から解放します。
—
2. なぜWindows API「GetDiskFreeSpaceEx」を使うのか？
VBA標準の関数（例えば `Dir` や `FileSystemObject` の一部機能）でもドライブの空き容量を調べることはできますが、ネットワーク共有フォルダ（UNCパス: `\\server\share`）を対象にした場合や、テラバイト級の大容量ストレージを扱う際に、32bit整数の制限（約2GB〜4GB）に引っかかり、オーバーフローや誤判定を起こすという落とし穴があります。
そこで登場するのが、Windowsが提供する本物のAPI `GetDiskFreeSpaceEx` です。
【VBA標準の制限】
32bit整数の壁 ──► 2GB以上の空き容量でオーバーフローを起こすリスク
【Windows API: GetDiskFreeSpaceEx】
64bit整数 (ULARGE_INTEGER) ──► ネットワークパスもTB単位のディスクも正確に測定可能！
64bit/32bit両対応の宣言（Declare文）のコツ
現代のOfficeは64bit版が主流ですが、組織によっては32bit版が混在しています。どちらでもエラーなく動くように `#If VBA7 Then` を使って宣言を切り替えます。
—
3. 実装：スマートストレージ保存マクロの全コード
標準モジュールを1つ作成し、以下のコードをそのまま貼り付けてみてください。まずは動かせる完全なコードを用意しました。
Option Explicit
‘ ==============================================================================
‘ 1. Windows API 宣言部（32bit / 64bit 両対応）
‘ ==============================================================================
If VBA7 Then
Private Declare PtrSafe Function GetDiskFreeSpaceEx Lib “kernel32” Alias “GetDiskFreeSpaceExA” ( _
ByVal lpDirectoryName As String, _
ByRef lpFreeBytesAvailableToCaller As Currency, _
ByRef lpTotalNumberOfBytes As Currency, _
ByRef lpTotalNumberOfFreeBytes As Currency) As Long
Else
Private Declare Function GetDiskFreeSpaceEx Lib “kernel32” Alias “GetDiskFreeSpaceExA” ( _
ByVal lpDirectoryName As String, _
ByRef lpFreeBytesAvailableToCaller As Currency, _
ByRef lpTotalNumberOfBytes As Currency, _
ByRef lpTotalNumberOfFreeBytes As Currency) As Long
End If
‘ ==============================================================================
‘ 2. メインプロシージャ：スマート保存の実行
‘ ==============================================================================
Public Sub SmartSavePresentation()
Dim targetPresentation As Presentation
Set targetPresentation = ActivePresentation
‘ 保存先フォルダとファイル名の決定（必要に応じて変更してください）
Dim saveFolderPath As String
Dim targetFilePath As String
saveFolderPath = “C:\Temp” ‘ テスト用の保存先（実在するフォルダを指定）
targetFilePath = saveFolderPath & “\SmartSaved_” & Format(Now, “yyyymmdd_hhnnss”) & “.pptx”
‘ 末尾の円マーク（バックスラッシュ）の整形
If Right(saveFolderPath, 1) <> “\” Then saveFolderPath = saveFolderPath & “\”
‘ フォルダが存在しない場合のフェールセーフ
If Dir(saveFolderPath, vbDirectory) = “” Then
MsgBox “指定されたフォルダが存在しません: ” & saveFolderPath, vbCritical, “エラー”
Exit Sub
End If
‘ — ステップ1: 保存先ディスクの空き容量を取得 (MB単位) —
Dim freeSpaceMB As Double
freeSpaceMB = GetFreeDiskSpaceMB(saveFolderPath)
‘ 閾値の設定（例: 空き容量が 100MB 未満なら圧縮モードを発動）
Const SAFETY_THRESHOLD_MB As Double = 100#
Debug.Print “【診断】保存先の空き容量: ” & Format(freeSpaceMB, “#,
0.00″) & ” MB”
‘ — ステップ2: 容量判定と画像圧縮の実行 —
If freeSpaceMB < SAFETY_THRESHOLD_MB Then
Dim userResponse As VbMsgBoxResult
userResponse = MsgBox("保存先ディスクの空き容量が逼迫しています (" & Format(freeSpaceMB, "0.0") & " MB)。" & vbCrLf & _
"スライド内の画像を自動圧縮して軽量化保存しますか？", _
vbExclamation + vbYesNo, "容量警告")
If userResponse = vbYes Then
Call CompressAllPictures(targetPresentation)
Else
MsgBox "圧縮をスキップし、そのまま保存を試みます。", vbInformation
End If
End If
' --- ステップ3: 安全に保存 ---
On Error GoTo SaveErrorHandler
targetPresentation.SaveCopyAs targetFilePath
On Error GoTo 0
MsgBox "正常に保存が完了しました！" & vbCrLf & "保存先: " & targetFilePath, vbInformation, "保存成功"
Exit Sub
SaveErrorHandler:
MsgBox "保存中にエラーが発生しました: " & Err.Description, vbCritical, "保存失敗"
End Sub
' ==============================================================================
' 3. ディスクの空き容量を計算する関数 (APIラッパー)
' ==============================================================================
Private Function GetFreeDiskSpaceMB(ByVal folderPath As String) As Double
Dim userFreeBytes As Currency
Dim totalBytes As Currency
Dim totalFreeBytes As Currency
Dim apiResult As Long
' API呼び出し（Currency型は暗黙的に10,000倍された整数として扱われる）
apiResult = GetDiskFreeSpaceEx(folderPath, userFreeBytes, totalBytes, totalFreeBytes)
If apiResult <> 0 Then
‘ Currency型の値をバイト数に戻すため 10,000 を掛け、メガバイト(1024^2)へ変換
GetFreeDiskSpaceMB = (userFreeBytes 10000#) / (1024# 1024#)
Else
‘ 取得失敗時は安全側に倒して「容量ゼロ」を返す
GetFreeDiskSpaceMB = 0#
End If
End Function
‘ ==============================================================================
‘ 4. スライド全体の画像を最適化・圧縮するプロシージャ
‘ ==============================================================================
Private Sub CompressAllPictures(ByRef targetPres As Presentation)
Dim sld As Slide
Dim shp As Shape
Dim pictureFound As Boolean
pictureFound = False
‘ 画像が存在するか走査
For Each sld In targetPres.Slides
For Each shp In sld.Shapes
If IsTargetPictureShape(shp) Then
pictureFound = True
shp.Select
Exit For
End If
Next shp
If pictureFound Then Exit For
Next sld
If Not pictureFound Then
Debug.Print “圧縮対象の画像が存在しませんでした。”
Exit Sub
End If
‘ 画像が選択されている状態で Officeネイティブの画像圧縮コマンドを実行
On Error Resume Next
‘ PictureCompress: 画像の圧縮ダイアログを自動実行、または内部最適化を適用
Application.CommandBars.ExecuteMso (“PictureCompress”)
On Error GoTo 0
Debug.Print “画像圧縮コマンドのキックが完了しました。”
End Sub
‘ ==============================================================================
‘ 5. シェイプが画像かどうかを判定するヘルパー（グループ化図形対応）
‘ ==============================================================================
Private Function IsTargetPictureShape(ByVal targetShape As Shape) As Boolean
IsTargetPictureShape = False
‘ リンク画像、埋め込み画像かを判定
If targetShape.Type = msoPicture Then
IsTargetPictureShape = True
ElseIf targetShape.Type = msoLinkedPicture Then
IsTargetPictureShape = True
End If
End Function
—
4. コードの深掘り解説：ここがプロのポイント！
① Currency型を使った「超巨大な数値」の扱い
Windows APIの `ULARGE_INTEGER` は64bit符号なし整数です。しかしVBAには純粋な64bit符号なし整数型がありません。
そこで、`Currency` 型を活用します。
Currency型は内部的に8バイト整数であり、小数点を4桁固定で保持する仕組みになっています。そのため、「APIに渡した後に 10,000 を掛ける」ことで、ビットのズレを起こさずに正確なバイト数を復元できます。このテクニックはAPI連携における定番の知恵です。
② `ExecuteMso (“PictureCompress”)` の賢い使い方
VBAから「画像の解像度を一括で下げる」操作を自前で実装しようとすると、画像を一度ローカルにエクスポートして、外部ツールでリサイズして再挿入する…という何百行もの複雑で壊れやすいコードが必要になります。
しかし、PowerPoint内部には世界最高峰の画像圧縮アルゴリズムが最初から備わっています。
スライド内の画像を1つ `Select` した状態で `Application.CommandBars.ExecuteMso (“PictureCompress”)` を叩いてあげることで、PowerPoint標準の最適化機能を最も安定した状態で呼び出すことができます。
—
5. 陥りやすい罠（トラブルシューティング）
開発現場でよく直面するエラーと、その回避策を押さえておきましょう。
罠1: ネットワークパス（UNCパス）でAPIが「0」を返して失敗する
- 原因: `\\server\share` のように共有フォルダ直下を指定した際、末尾に `\` が抜けているとWindowsがディレクトリとして認識できないことがあります。
- 解決策: コード内の `If Right(saveFolderPath, 1) <> “\” Then…` で示したように、必ずパスの末尾を `\` で終わらせてからAPIへ渡すのが鉄則です。
罠2: グループ化された図形の中に写真がある場合
- 注意点: グループ化された図形（`msoGroup`）の内部にある画像は、`Slide.Shapes` のトップレベル走査だけでは検知できません。
- 次へのステップ: さらに完璧を目指す場合は、`targetShape.Type = msoGroup` だった際に `targetShape.GroupItems` を再帰的に探索する関数を組み込むと、完全に隙のないコードに進化します。
—
6. まとめ
お疲れ様でした！今回の内容をマスターできたなら、マクロ初学者からは完全に脱却しています。
- Windows API（GetDiskFreeSpaceEx）を使えば、テラバイト級やネットワークドライブの容量も正確に把握できる。
- エラーが起きる前に防ぐ（プロアクティブな防御）設計こそが、業務で信頼される自動化ツールの神髄。
- Office標準の強力な機能（ExecuteMso）をうまく組み合わせることで、車輪の再発明を避け、短く堅牢なコードが書ける。
「システムが止まらないためのフェールセーフ（安全装置）」を仕込む面白さに気づくと、VBAプログラミングはもっと楽しくなります。
ぜひ、あなたの現場のツールにもこのスマートなストレージ保護ロジックを組み込んで、同僚やクライアントをあっと驚かせてみてくださいね！
