【テクニカル・上級編】【アスペクト比維持のサイズ統一】`PageSetup` をハックし、異なるスライドサイズや余白設定を持つ複数プレゼンを標準フォーマットへ一括変換するコンバーター – PowerPoint VBA解析バイブル

スポンサーリンク

【アスペクト比維持のサイズ統一】PageSetupをハックし、異なるスライドサイズや余白設定を持つ複数プレゼンを標準フォーマットへ一括変換するコンバーター

企業内に蓄積されたレガシーなスライド資産。4:3の旧フォーマット、非標準的なカスタムサイズ、作成者の気まぐれで設定された余白――これらが混在する「マルチアスペクト比の混沌」を前に、多くの社内システム管理者やエンジニアは、PowerPointの標準機能が引き起こす「歪み」という悪夢に直面します。

PowerPointのUIからスライドサイズを変更すると、オブジェクトが横に引き伸ばされて真円が楕円になり、ロゴ画像は歪み、フォントは枠から溢れ出します。また、VBAの `Presentation.PageSetup` を単純に書き換えるだけでは、PowerPoint内部の不透明なスケーリングエンジン(「最大化」か「サイズに合わせて調整」か)が強制介入し、コードによる制御をすり抜けてレイアウトを破壊します。

本稿では、この問題に対する完全な解を提示します。
Win32 APIによる描画ロック、COMオブジェクトの厳密なライフサイクル管理、そして「数学的再配置アルゴリズム(レターボックス/ピラーボックス自動生成)」を組み合わせ、完全に歪みのないピクセルパーフェクトなサイズ一括変換コンバーターを構築します。

1. `PageSetup` の深淵と、アスペクト比変換におけるレイアウト崩壊の正体

1.1 なぜ `PageSetup.SlideWidth` / `SlideHeight` を変更するとレイアウトが崩壊するのか

PowerPointオブジェクトモデルにおいて、スライドの物理的な寸法を決定するのは `Presentation.PageSetup` オブジェクトです。しかし、このプロパティを書き換えた瞬間、PowerPointはドキュメント全体のレイアウトを強制的に再計算します。

PowerPoint 2013以降、スライドサイズ変更時に以下の2つの選択を迫るダイアログが表示されるようになりました。

  • 最大化 (Maximize): コンテンツのサイズを維持したままスライドサイズを変更するため、アスペクト比が異なるとコンテンツがスライドからはみ出す。
  • サイズに合わせて調整 (Ensure Fit): スライド内に収まるようにコンテンツを縮小するが、縦横比が強制的に引き伸ばされ、画像や図形が歪む。

VBAから `PageSetup.SlideWidth` や `SlideHeight` を直接変更した場合、内部的にはデフォルトの自動スケーリングが適用され、我々開発者が望まない「歪んだ自動変形」が実行されてしまいます。VBAのAPIには、このスケーリング挙動を完全にサイレントかつ精緻に制御する引数が存在しません。

1.2 歪みをゼロにする「数学的再配置アルゴリズム」

この問題を回避する唯一の堅牢なアプローチは、「サイズ変更前に、全スライドのオブジェクト群をアスペクト比を維持したまま一時的にグループ化してスケーリングし、キャンバスサイズ変更後に中央へ再配置する」という幾何学的アプローチです。

【変換プロセス】
1. 元のスライドサイズとアスペクト比 (R_orig) を取得
2. ターゲットサイズとアスペクト比 (R_tgt) を定義
3. 歪みが発生しない最大公約数的なスケールファクター (S) を算出
4. 各スライドの全シェイプを「一時グループ化」
5. グループの縦横比を維持(LockAspectRatio = msoTrue)したまま S倍にリサイズ
6. ターゲットキャンバスの幾何学的中心(Center-Align)へ移動
7. グループを解除
8. PageSetup をターゲットサイズへ書き換え

このアルゴリズムにより、いかなる変則サイズからであっても、16:9 や 4:3 の標準フォーマットへ、歪みを一切発生させずに「レターボックス(上下に余白)」または「ピラーボックス(左右に余白)」の形で完璧に収めることが可能になります。

2. システムアーキテクチャと設計思想

エンタープライズ環境での一括バッチ処理に耐えうるツールとするため、以下の3つの設計思想をコードに組み込みます。

1. Win32 APIによる描画・リフレッシュの完全ロック
数百枚のスライドを処理する際、PowerPointの画面更新がボトルネックとなり、描画遅延やメモリ不足によるクラッシュ(`Out of Memory`)を引き起こします。`Application.ScreenUpdating = False` だけでは不十分なケースがあるため、Windows OSのウィンドウマネージャー層に対して直接 `LockWindowUpdate` および `SendMessage` を発行し、描画を完全に凍結します。
2. COMオブジェクトの厳密なライフサイクル管理
VBAが暗黙的に生成するラッパーオブジェクトは、明示的に解放しない限りメモリ(ガベージコレクタがないVBAのランタイムメモリ)に蓄積されます。特にループ内での `Slide` や `Shape` オブジェクトへの参照は、`Set Object = Nothing` によるクリーンアップを徹底し、ミリ秒単位でのメモリ解放を行います。
3. レガシー環境(32bit/64bit Office)への完全な互換性
現在も現場に残る 32bit版 Office と、モダンな 64bit版 Office の双方で動作するよう、Win32 APIの宣言には `VBA7` および `Win64` 条件付きコンパイル定数を適用し、`LongPtr` を適切に扱います。

3. 極限のコード実装:プロダクションクオリティのコンバーター

以下のコードをPowerPointの標準モジュールに配置、またはExcel VBAから参照設定(`Microsoft PowerPoint Object Library`)を追加して実行してください。ここではPowerPoint VBA内でスタンドアロン動作するコードを示します。

Option Explicit

‘ ==============================================================================
‘ Win32 API 宣言(32bit / 64bit 互換設計)
‘ ==============================================================================
If VBA7 Then
Private Declare PtrSafe Function LockWindowUpdate Lib “user32” (ByVal hwndLock As LongPtr) As Long
Private Declare PtrSafe Function FindWindowW Lib “user32” (ByVal lpClassName As LongPtr, ByVal lpWindowName As LongPtr) As LongPtr
Private Declare PtrSafe Function SendMessageW Lib “user32” (ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Else
Private Declare Function LockWindowUpdate Lib “user32” (ByVal hwndLock As Long) As Long
Private Declare Function FindWindowW Lib “user32” (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function SendMessageW Lib “user32” (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
End If

Private Const WM_SETREDRAW As Long = &HB
Private Const PPT_CLASS_NAME As String = “PPTFrameClass”

‘ ==============================================================================
‘ 構造体・定数定義
‘ ==============================================================================
Public Type TargetSize
Width As Single
Height As Single
Name As String
End Type

‘ 標準的なスライドサイズ定義 (単位: ポイント, 1 inch = 72 pt)
Public Const SIZE_16_9_W As Single = 960 ‘ 13.33 インチ (標準 16:9)
Public Const SIZE_16_9_H As Single = 540
Public Const SIZE_4_3_W As Single = 720 ‘ 10 インチ (標準 4:3)
Public Const SIZE_4_3_H As Single = 540

”’

”’ 複数プレゼンテーションのスライドサイズを、アスペクト比を維持したまま一括変換するメインエントリポイント
”’

Public Sub BatchConvertPresentationSizes()
Dim targetFolder As String
Dim filePattern As String
Dim fileName As String
Dim pptApp As PowerPoint.Application
Dim pres As PowerPoint.Presentation
Dim targetFormat As TargetSize
Dim processedCount As Long
Dim errorCount As Long
Dim tStart As Double

‘ ————————————————————————–
‘ 1. 環境初期化とパラメータ設定
‘ ————————————————————————–
tStart = Timer

‘ ターゲットフォーマットの設定(16:9 に統一する場合)
targetFormat.Width = SIZE_16_9_W
targetFormat.Height = SIZE_16_9_H
targetFormat.Name = “Standard_16x9”

‘ 処理対象フォルダの選択(本番環境ではダイアログ等で動的に取得することを推奨)
‘ ここではマクロ有効プレゼンテーションと同一フォルダを対象とする
targetFolder = ActivePresentation.Path & “\”
If targetFolder = “\” Then
MsgBox “マクロを実行する前に、このプレゼンテーションを保存してください。”, vbCritical, “エラー”
Exit Sub
End If

‘ PowerPointアプリケーションインスタンスの確保
Set pptApp = PowerPoint.Application
pptApp.DisplayAlerts = ppAlertsNone ‘ 警告ダイアログを抑制

‘ APIによる画面描画の凍結
Dim pptHWnd As LongPtr
#If VBA7 Then
pptHWnd = FindWindowW(StrPtr(PPT_CLASS_NAME), 0)
#Else
pptHWnd = FindWindowW(StrPtr(PPT_CLASS_NAME), 0)
#End If

If pptHWnd <> 0 Then
Call SendMessageW(pptHWnd, WM_SETREDRAW, 0, 0)
Call LockWindowUpdate(pptHWnd)
End If

On Error GoTo ErrorHandler

‘ ————————————————————————–
‘ 2. ディレクトリ走査とバッチ変換処理
‘ ————————————————————————–
filePattern = “.ppt” ‘ .ppt, .pptx, .pptm を対象
fileName = Dir(targetFolder & filePattern)

Do While fileName <> “”
‘ 自身(マクロ実行中のファイル)は処理から除外する
If fileName <> ActivePresentation.Name And Left(fileName, 2) <> “~$” Then
Dim fullPath As String
fullPath = targetFolder & fileName

Debug.Print “処理開始: ” & fileName

‘ プレゼンテーションを非表示、かつウィンドウなしで開く(メモリ節約と高速化)
Set pres = pptApp.Presentations.Open(fullPath, WithWindow:=msoFalse)

‘ 変換アルゴリズムの実行
If ConvertSinglePresentation(pres, targetFormat) Then
pres.Save
processedCount = processedCount + 1
Debug.Print “処理成功: ” & fileName
Else
errorCount = errorCount + 1
Debug.Print “処理失敗: ” & fileName
End If

‘ 厳密なオブジェクト解放
pres.Close
Set pres = Nothing

‘ ガベージコレクションを促すためのOSイベント処理
DoEvents
End If
fileName = Dir()
Loop

‘ ————————————————————————–
‘ 3. 後処理と結果表示
‘ ————————————————————————–
CleanExit:
‘ 画面描画のロック解除
If pptHWnd <> 0 Then
Call LockWindowUpdate(0)
Call SendMessageW(pptHWnd, WM_SETREDRAW, 1, 0)
End If
pptApp.DisplayAlerts = ppAlertsAll

MsgBox “変換処理が完了しました。” & vbCrLf & _
“成功: ” & processedCount & ” 件” & vbCrLf & _
“失敗: ” & errorCount & ” 件” & vbCrLf & _
“実行時間: ” & Format(Timer – tStart, “0.00”) & ” 秒”, vbInformation, “処理完了”
Exit Sub

ErrorHandler:
Debug.Print “システムエラー発生: ” & Err.Description
errorCount = errorCount + 1
If Not pres Is Nothing Then
On Error Resume Next
pres.Close
Set pres = Nothing
On Error GoTo 0
End If
Resume CleanExit
End Sub

”’

”’ 単一プレゼンテーションのサイズを、アスペクト比を維持して安全に変換する
”’

Private Function ConvertSinglePresentation(ByRef pres As PowerPoint.Presentation, ByRef target As TargetSize) As Boolean
On Error GoTo ConvertError

Dim origW As Single: origW = pres.PageSetup.SlideWidth
Dim origH As Single: origH = pres.PageSetup.SlideHeight

‘ 既にターゲットサイズと同一である場合はスキップ
If Abs(origW – target.Width) < 0.1 And Abs(origH - target.Height) < 0.1 Then ConvertSinglePresentation = True Exit Function End If Dim origRatio As Double: origRatio = origW / origH Dim targetRatio As Double: targetRatio = target.Width / target.Height ' スケールファクターの算出 (歪みが発生しない最大フィットサイズ) Dim scaleFactor As Single If origRatio > targetRatio Then
‘ 元のほうが横長(例: 16:9 から 4:3 への変換など、横幅基準でスケーリング)
scaleFactor = target.Width / origW
Else
‘ 元のほうが縦長(例: 4:3 から 16:9 への変換など、縦幅基準でスケーリング)
scaleFactor = target.Height / origH
End If

Dim sld As PowerPoint.Slide
Dim shp As PowerPoint.Shape
Dim shpRange As PowerPoint.ShapeRange
Dim gShp As PowerPoint.Shape
Dim shapeCount As Long
Dim i As Long

‘ 各スライド内の全オブジェクトを数学的に再配置
For Each sld In pres.Slides
shapeCount = sld.Shapes.Count

‘ スライド内にシェイプが存在する場合のみ処理
If shapeCount > 0 Then
‘ プレースホルダー(スライドマスター由来のレイアウト枠)と
‘ 通常のシェイプを区別して処理するための配列インデックスを構築
Dim shapeNames() As String
ReDim shapeNames(1 To shapeCount)
Dim validShapeCount As Long: validShapeCount = 0

For Each shp In sld.Shapes
‘ 変換プロセス中にロックされた、あるいは削除不可能な特殊オブジェクトを除外
If shp.Type <> msoPlaceholder Then
validShapeCount = validShapeCount + 1
shapeNames(validShapeCount) = shp.Name
End If
Next shp

‘ 通常シェイプが存在する場合、一時グループ化してアスペクト比維持リサイズを実行
If validShapeCount > 0 Then
ReDim Preserve shapeNames(1 To validShapeCount)
Set shpRange = sld.Shapes.Range(shapeNames)
Set gShp = shpRange.Group

‘ アスペクト比を固定
gShp.LockAspectRatio = msoTrue

‘ リサイズ
gShp.Width = gShp.Width scaleFactor

‘ ターゲットサイズキャンバス内における「中央配置」の座標計算
Dim newLeft As Single
Dim newTop As Single

newLeft = (target.Width – gShp.Width) / 2
newTop = (target.Height – gShp.Height) / 2

gShp.Left = newLeft
gShp.Top = newTop

‘ グループ化を解除して元の構造に戻す
gShp.Ungroup

‘ COMオブジェクトの解放
Set gShp = Nothing
Set shpRange = Nothing
End If
End If

‘ メモリリーク対策
Set sld = Nothing
Next sld

‘ 最後に、物理キャンバスサイズを書き換える
‘ (中のコンテンツは既にターゲット比率内に収まるようリサイズ&中央寄せされているため、
‘ PageSetupによる歪みは理論上発生しない)
pres.PageSetup.SlideWidth = target.Width
pres.PageSetup.SlideHeight = target.Height

ConvertSinglePresentation = True
Exit Function

ConvertError:
Debug.Print “変換エラー [File: ” & pres.Name & “] : ” & Err.Description
ConvertSinglePresentation = False
End Function

4. ディープダイブ:Win32 APIとCOMメモリ管理の深層

このコードが、一般的な「マクロの記録」から派生したVBAスクリプトと決定的に異なる点について、アーキテクチャの視点から解説します。

4.1 Win32 APIによる描画停止(LockWindowUpdate & SendMessage)

PowerPoint VBAで大量のオブジェクト(Shape)をグループ化・リサイズ・配置変更・グループ解除すると、VBAエンジンはステップごとに画面の再描画(Repaint)を試みます。これが数千回繰り返されると、GDI(Graphics Device Interface)リソースが枯渇し、アプリケーションがフリーズするか、最悪の場合は強制終了します。

本アーキテクチャでは、Windowsのウィンドウマネージャーに対して以下の2段階の処理を行っています。

1. `SendMessageW(pptHWnd, WM_SETREDRAW, 0, 0)`
PowerPointのメインウィンドウに対して、描画フラグを `False` に設定します。これにより、ウィンドウ内部のコントロール自身による再描画要求が全て無視されます。
2. `LockWindowUpdate(pptHWnd)`
指定したウィンドウ(PowerPoint)の描画領域をOSレベルでロックし、デバイスコンテキスト(DC)への出力を一時的にメモリ上のバックバッファに固定します。

このダブルロック機構により、画面のちらつき(Flicker)が完全に消失するだけでなく、処理速度が物理的に数倍から数十倍に跳ね上がります。

4.2 COM参照カウントとメモリリークの排除

VBAはCOM(Component Object Model)テクノロジーをベースに動作しています。`For Each sld In pres.Slides` や `For Each shp In sld.Shapes` と書くたびに、VBAの内部ではC++オブジェクトへの参照ポインタが生成され、参照カウントがインクリメントされます。

Set sld = Nothing

ループの最後でこれを明示的に行うのは、単なるおまじないではありません。VBAのガベージコレクションは参照カウントが「0」になった瞬間にメモリを解放するため、明示的な `Nothing` の代入は、バッチ処理においてプロセス物理メモリ(Private Bytes)の肥大化を防ぎ、OSから「リソース不足」でプロセスが強制的にキルされるのを防ぐ絶対的な盾となります。

4.3 プレースホルダー(Placeholder)の除外設計

スライドマスターに基づいたタイトル枠やフッター枠(プレースホルダー)は、グループ化(`Group`)メソッドを実行するとエラーを返します。PowerPointの仕様上、マスターと動的に結合しているオブジェクトはグループ化できないからです。

本コードでは `shp.Type <> msoPlaceholder` というフィルタリングを施し、ユーザーが独自に配置した図形、グラフ、画像、テキストボックスのみをグループ化・スケーリングの対象としています。プレースホルダーはスライドサイズ変更時にPowerPointのマスターレイアウトの定義に従って自動的に再配置されるため、この設計こそがランタイムエラーを回避するための現実的な最適解となります。

5. レガシー資産をモダンインフラへ適合させるということ

企業のシステム管理において、フォーマットの不整合は単なる「見た目の問題」に留まりません。社内システムやドキュメント管理サーバー(SharePoint、Teams、社内Wiki等)にアップロードされたスライドが、デバイスやアスペクト比の違いによってレイアウト崩れを起こしている状態は、企業のブランド価値を毀損し、情報の伝達コストを著しく増大させます。

本稿で示したコンバーターは、PowerPointが抱える「スケーリングの限界」を数学的な再配置アルゴリズムで克服し、Win32 APIという極めて低レイヤーの制御技術を用いてエンタープライズに耐えうる堅牢性を担保したものです。

このような低レイヤーへのアプローチとオブジェクトモデルの徹底的な制御こそが、ブラックボックス化されたOffice製品を「真のシステムの一部」として手懐けるための、唯一にして最強の武器なのです。

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