【入門編】【上級者】保存先のディスクストレージ残量をWindows APIで事前に取得し、容量ひっ迫時に高解像度画像を自動ダウンサンプル・圧縮してからエラーなく保存するスマートストレージマクロ – PowerPoint VBA解析バイブル

【極限の知見】保存エラーを未然に防ぐ「知能を持つマクロ」の作り方 〜Windows APIと画像圧縮の融合〜

「マクロの記録」を使って、なんとか自動化の第一歩を踏み出したあなた。素晴らしい進歩です。
しかし、プロフェッショナルの世界では、記録されたコードをそのまま使うことは稀です。なぜなら、「プログラムは常に、予期せぬ環境（エラー）と戦っているから」です。

例えば、大量の高解像度画像を含んだプレゼンテーションを、容量の少ないUSBメモリやネットワークドライブに保存しようとした瞬間、何が起きるでしょうか？

「実行時エラー ’70’: 書き込み禁止です」や「ディスク領域が不足しています」といった無慈悲なメッセージとともに、それまで積み上げてきた自動化のプロセスが崩壊します。

今日は、そんな「環境の不備」に負けない、「自ら状況を判断して動く、知能を持ったマクロ」の設計思想を伝授しましょう。

1. アーキテクトの視点：なぜ「普通のVBA」では足りないのか？

一般的なVBAは、「自分が今、どんな環境にいるか」を知りません。
「保存しろ」と命令されたら、保存先が空っぽの砂漠（容量不足のディスク）であっても、全力で砂を投げ続け、エラーで力尽きる。これが、マクロの記録レベルの限界です。

プロのエンジニア（アーキテクト）は、命令を出す前に「観察」します。

1. 観察: 保存先のディスクに、どれだけの空き容量があるか？（Windows APIを使用）
2. 判断: 空き容量が、ファイルサイズに対して危険なレベルか？
3. 対策: もし危険なら、保存前に「画像の画質を落として軽量化」する工程を挟む。
4. 実行: 安全が確認できてから、保存を完了する。

この「観察→判断→対策」のサイクルこそが、単なる「自動化」を「業務システム」へと昇華させる境界線です。

2. 武器の準備：Windows APIで「ディスクの真実」を見る

VBAの標準機能には、残念ながら「ディスクの空き容量をバイト単位で正確に取得する」という直接的な関数はありません。そこで、Windowsの核（カーネル）に直接問いかける「Windows API」という強力な武器を使います。

今回使用するのは `GetDiskFreeSpaceEx` です。これを使えば、OSが把握している正確な空き容量を、私たちの手元に引き寄せることができます。

3. 実装：スマートストレージマクロの全貌

それでは、魂を込めて書いたコードを見ていきましょう。このコードは、64bit版のOfficeでも動作するように設計された、モダンな書き方です。

Option Explicit

' =================================================================
' Windows API の宣言
' ディスクの空き容量を取得するための関数をOSから呼び出します。
' PtrSafe は 64bit環境での互換性を確保するための呪文です。
' =================================================================
If VBA7 Then
    Private Declare PtrSafe Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" ( _
        ByVal lpDirectoryName As String, _
        ByVal lpFreeBytesAvailable As Currency, _
        ByVal lpTotalNumberOfBytes As Currency, _
        ByVal lpTotalNumberOfFreeBytes As Currency) As Long
Else
    Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" ( _
        ByVal lpDirectoryName As String, _
        ByVal lpFreeBytesAvailable As Currency, _
        ByVal lpTotalNumberOfBytes As Currency, _
        ByVal lpTotalNumberOfFreeBytes As Currency) As Long
End If

' =================================================================
' メイン処理：スマートに保存を行う
' =================================================================
Sub SmartSavePresentation()
    Dim targetPath As String
    Dim freeSpaceBytes As Currency
    Dim thresholdBytes As Currency
    Dim pptApp As Object
    Dim pres As Presentation
    
    ' 1. 保存先のパスを設定（例：デスクトップに保存）
    targetPath = Environ("USERPROFILE") & "\Desktop\SmartSaved_Presentation.pptx"
    
    Set pres = ActivePresentation
    
    ' 2. 保存先のディスク空き容量を取得
    ' 引数にはフォルダのパスを渡します（ファイル名ではなく、親フォルダのパス）
    freeSpaceBytes = GetFreeDiskSpace(Left(targetPath, InStrRev(targetPath, "\")))
    
    ' 💡 安全マージンとして「500MB」を下回っていたら警告モードへ
    ' 500MB = 500 * 1024 * 1024 bytes
    thresholdBytes = 500 * 1024 * 1024
    
    On Error GoTo ErrorHandler
    
    If freeSpaceBytes < thresholdBytes Then
        ' 3. 【判断と対策】容量が少ない場合、画像を圧縮する
        MsgBox "⚠️ 保存先の空き容量が不足しています（残り約" & _
               Format(freeSpaceBytes / 1024 / 1024, "0") & " MB）。" & vbCrLf & _
               "自動的に画像の圧縮処理を行い、容量を節約してから保存します。", vbExclamation, "スマートストレージ警告"
        
        ' 画像を圧縮するプロシージャを呼び出し
        CompressAllPictures
    End If
    
    ' 4. 保存の実行
    pres.SaveAs targetPath
    MsgBox "✅ 安全に保存が完了しました！" & vbCrLf & "保存先: " & targetPath, vbInformation, "成功"
    
    Exit Sub

ErrorHandler:
    MsgBox "❌ 保存中に予期せぬエラーが発生しました。" & vbCrLf & _
           "エラー内容: " & Err.Description, vbCritical, "致命的なエラー"
End Sub

' =================================================================
' 関数：ディスクの空き容量を計算して返す
' =================================================================
Function GetFreeDiskSpace(folderPath As String) As Currency
    Dim freeBytes As Currency
    Dim totalBytes As Currency
    Dim totalFreeBytes As Currency
    Dim result As Long
    
    ' APIを呼び出して空き容量を取得
    result = GetDiskFreeSpaceEx(folderPath, freeBytes, totalBytes, totalFreeBytes)
    
    If result <> 0 Then
        GetFreeDiskSpace = freeBytes
    Else
        GetFreeDiskSpace = 0
    End If
End Function

' =================================================================
' 手順：PowerPointの機能を使って画像を圧縮する
' =================================================================
Sub CompressAllPictures()
    ' VBAには「画像を圧縮する」という直接のメソッドはありません。
    ' しかし、PowerPointの内部コマンド(MsoCommand)を呼び出すことで、
    ' UI操作を自動化し、高機能な圧縮エンジンを動かすことができます。
    
    On Error Resume Next
    ' 全ての図形を選択状態にする（圧縮対象を特定させるため）
    ' ※実際にはスライド内の画像を対象にするため、スライドをループして処理するのが理想的ですが、
    ' ここでは最も確実な「CommandBars」経由の実行方法を示します。
    
    ' PowerPointの「図の圧縮」ダイアログを呼び出すコマンド
    ' これにより、ユーザーに確認を求めつつ、高解像度画像を低解像度に落とせます。
    Application.CommandBars.ExecuteMso "PictureCompress"
    
    If Err.Number <> 0 Then
        MsgBox "画像圧縮の実行に失敗しました。手動で圧縮を行ってください。", vbCritical
    End If
    On Error GoTo 0
End Sub

4. コードの深層：ここが「プロ」のこだわり

このコードをただコピペして終わらせてはいけません。なぜこう書いたのか、その意図を理解してください。

① `Currency` 型の選択

空き容量の計算には `Long` ではなく `Currency` 型（または `Double`）を使っています。ディスク容量はテラバイト単位になると、通常の整数型（`Long`）では溢れて（オーバーフローして）しまいます。「データの重み（桁数）を予測する」。これがエンジニアの基本です。

② `ExecuteMso` による「UIのハック」

「画像を圧縮する」という命令を、一つ一つの図形に対してループで回して処理するのは、非常に重く、かつコードも複雑になります。
そこで私は、PowerPointが標準で持っている「図の圧縮（PictureCompress）」という内部コマンドを、`CommandBars.ExecuteMso` で直接叩く手法を選びました。これは、既存の高度な機能を「再利用」する、極めて効率的なアプローチです。

③ エラーハンドリングの重要性

`On Error GoTo ErrorHandler` を記述しています。
自動化において、エラーが起きた時に「何が起きたか分からないまま止まる」のは最悪の事態です。エラーメッセージを丁寧に表示させることで、次に人間が何をすべきか（例：別のドライブに保存する、など）を導くことができます。

5. まとめ：脱・初心者へのステップ

今回学んだことは、単なる「保存マクロ」ではありません。

• OSのレベル（API）で環境を把握する
• リスクを事前に検知し、動的に挙動を変える
• 既存の強力な機能をスマートに呼び出す

これらは、どんなプログラミング言語においても共通する「設計の原則」です。

「マクロの記録」で学んだ「操作の形」に、今回学んだ「論理（ロジック）」を組み合わせてみてください。そうすれば、あなたの作るツールは、単なる便利ツールを超えて、誰にも壊せない「堅牢なシステム」へと進化するはずです。

さあ、次はどんな「不条理なエラー」を、あなたのコードで解決しましょうか？応援していますよ。