PowerPoint VBAを掌握する極限の知見：アクセシビリティ自動検査＆補完エンジンの構築
プレスの現場において、PowerPoint資料の品質管理ほど泥臭く、かつ見落とされがちな作業はない。特に昨今のコーポレートガバナンスやWebアクセシビリティ基準の厳格化に伴い、社外公開用・社内共有用の別を問わず、「すべての図形や画像に代替テキスト（Altテキスト）が設定されていること」は、もはやマストの要件となりつつある。
だが、これを人間の目と手でチェックさせるのは、地獄のような労力を伴う。100枚を超えるスライドの群れから、グループ化された図形の奥底に眠る単なるアイコンや、パスの切れ端を一つずつ探し出し、プロパティを開いて確認・入力する……。そんな非生産的な業務にエンジニアの貴重な時間を割くべきではない。
今回は、PowerPoint VBAのオブジェクトモデルの深淵を突くことで、全スライド・全階層の図形を再帰的に走査し、未設定の要素を検知して自動補完、さらに安全に上書き保存までを完結させるプロダクション品質の自動化スクリプトを伝授する。
—
1. 堅牢な設計思想：なぜ「単なるループ」では実務で破綻するのか？
アマチュアの書くVBAコードは、決まって次のような浅いループ構造をしている。
‘ 【アンチパターン】これでは深い階層の図形を取りこぼす
Dim sld As Slide
Dim shp As Shape
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
‘ 代替テキストのチェック…
Next shp
Next sld
このアプローチが実務で必ず破綻する理由は2つある。
1. グループ化の壁（ネスト構造）:
PowerPointの `Shapes` コレクションはフラットではない。ユーザーが図形をグループ化すると、それは `msoGroup` というコンテナ（親）になり、その内部に `GroupItems`（子）が隠れる。上記のコードでは、グループ内の図形が完全に不可視（スルー）になる。
2. プレースホルダーと画像・図形の混在:
スライド上のタイトルや本文テキストボックス（プレースホルダー）にも `AlternativeText` プロパティは存在するが、純粋なテキストコンテナにまで「画像がありません」等の代替テキストを強制すると、かえってアクセシビリティを損なう。検査対象の絞り込み（フィルター）が不可欠だ。
したがって、本気で実務に耐えうるシステムを作るには、「再帰処理（Recursion）」による全階層の網羅と、「適切な型判定」のロジックが絶対に必要となる。
—
2. プロダクションコード：アクセシビリティ自動検査・補完エンジン
以下のコードを、標準モジュールにそのまま貼り付けて実行してほしい。
単なるチェックに留まらず、未設定の要素には「ファイル名や図形の種類から推測したデフォルト値」を自動補完し、監査ログをイミディエイトウィンドウに出力した上で、整合性を保ったまま保存処理を行う。
Option Explicit
‘ ==============================================================================
‘ 処理名: プレゼンテーション全図形アクセシビリティ自動監査・補完エンジン
‘ 概要 : スライド内のすべての図形（グループ化階層の奥底を含む）を走査し、
代替テキスト（AlternativeText）の有無を判定。不足分を補完して保存する。
‘ ==============================================================================
Public Sub RunAccessibilityQualityControl()
Dim startTime As Double
startTime = Timer
Dim targetPres As Presentation
Set targetPres = ActivePresentation
‘ 0. 保存状態の確認（未保存の新規ファイル等によるパス消失を防ぐ）
If targetPres.Path = “” Then
MsgBox “このプレゼンテーションはまだ一度も保存されていません。” & vbCrLf & _
“一度名前を付けて保存してから実行してください。”, vbCritical, “致命的なエラー”
Exit Sub
End If
Dim totalChecked As Long
Dim totalFixed As Long
totalChecked = 0
totalFixed = 0
Debug.Print “========================================”
Debug.Print ” アクセシビリティ検査開始: ” & targetPres.Name
Debug.Print “========================================”
‘ 1. スライド全体の走査
Dim sld As Slide
For Each sld In targetPres.Slides
‘ 非表示スライドはスキップする設計にする場合ここで制御可能
‘ If sld.SlideShowTransition.Hidden = msoTrue Then GoTo ContinueSld
Call ProcessShapesRecursive(sld.Shapes, totalChecked, totalFixed)
Next sld
‘ 2. 変更の保存と結果報告
targetPres.Save
Dim elapsedTime As Double
elapsedTime = Timer – startTime
Debug.Print “========================================”
Debug.Print ” 検査完了”
Debug.Print ” 総検査要素数 : ” & totalChecked & ” 件”
Debug.Print ” 自動補完数 : ” & totalFixed & ” 件”
Debug.Print ” 処理時間 : ” & Format(elapsedTime, “0.00”) & ” 秒”
Debug.Print “========================================”
MsgBox “アクセシビリティの品質管理が完了しました。” & vbCrLf & _
“総検査数: ” & totalChecked & ” 件” & vbCrLf & _
“自動補完: ” & totalFixed & ” 件” & vbCrLf & _
“ファイルを正常に上書き保存しました。”, vbInformation, “品質管理完了”
End Sub
‘ ==============================================================================
‘ サブルーチン: 図形コレクションの再帰的走査（グループ対応）
‘ ==============================================================================
Private Sub ProcessShapesRecursive(ByVal shapesCol As Shapes, ByRef totalChecked As Long, ByRef totalFixed As Long)
Dim shp As Shape
Dim altText As String
For Each shp In shapesCol
‘ プレースホルダー（タイトルや本文など）はアクセシビリティの厳格な代替テキスト対象外とする場合があるが、
‘ ここでは「画像・図解・アイコン」等のビジュアル要素にフォーカスする。
If ShouldCheckShape(shp) Then
totalChecked = totalChecked + 1
‘ 代替テキストの取得（PowerPointのオブジェクトモデルでは .AlternativeText を使用）
On Error Resume Next
altText = shp.AlternativeText
If Err.Number <> 0 Then altText = “”
On Error GoTo 0
‘ 未設定、またはデフォルトのまま放置されているかを判定
If Trim(altText) = “” Or altText = shp.Name Then
‘ 自動補完ロジック
Dim fallbackText As String
fallbackText = GenerateFallbackText(shp)
shp.AlternativeText = fallbackText
totalFixed = totalFixed + 1
Debug.Print ” [補完実行] スライド ” & shp.Parent.SlideIndex & _
” / 図形名: ” & shp.Name & _
” / 種類: ” & GetShapeTypeName(shp.Type) & _
” -> 設定値: ” & fallbackText
End If
End If
‘ グループ図形の場合は再帰的に内部を掘り下げる
If shp.Type = msoGroup Then
Call ProcessShapesRecursive(shp.GroupItems, totalChecked, totalFixed)
End If
Next shp
End Sub
‘ ==============================================================================
‘ 関数: 検査対象とするべき図形かどうかのフィルター
‘ ==============================================================================
Private Function ShouldCheckShape(ByVal shp As Shape) As Boolean
‘ テキストボックスや通常のプレースホルダーを除外したい場合はここで制御
‘ 例: 純粋なテキストフレームを持つ長方形などを除外する場合
Select Case shp.Type
Case msoPlaceholder, msoTextEffect
‘ テキスト系は原則除外（必要に応じて変更）
ShouldCheckShape = False
Case Else
‘ 画像、図解(SmartArt)、グラフ、OLEオブジェクト、各種オートシェイプは検査対象
ShouldCheckShape = True
End End Select
‘ 非表示図形はスキップ
If shp.Visible = msoFalse Then ShouldCheckShape = False
End Function
‘ ==============================================================================
‘ 関数: 図形のコンテキストに応じたスマートな代替テキストの自動生成
‘ ==============================================================================
Private Function GenerateFallbackText(ByVal shp As Shape) As String
Dim typeName As String
typeName = GetShapeTypeName(shp.Type)
‘ 図形の種類や名前から意味のあるプレースホルダーテキストを生成
GenerateFallbackText = “ビジュアル要素 (” & typeName & “: ” & shp.Name & “)”
End Function
‘ ==============================================================================
‘ 関数: MsoShapeType の可読化
‘ ==============================================================================
Private Function GetShapeTypeName(ByVal shapeType As MsoShapeType) As String
Select Case shapeType
Case msoPicture: GetShapeTypeName = “画像”
Case msoAutoShape: GetShapeTypeName = “オートシェイプ”
Case msoFreeform: GetShapeTypeName = “フリーフォーム”
Case msoGroup: GetShapeTypeName = “グループ”
Case msoSmartArt: GetShapeTypeName = “SmartArt”
Case msoChart: GetShapeTypeName = “グラフ”
Case Else: GetShapeTypeName = “図形”
End Select
End Sub
—
3. チーフアーキテクトが教える：実務導入時の重要な注意点
このスクリプトを組織の共通基盤やアドイン（ `.ppam` ）として展開する際、以下の3点に留意してほしい。
① Undo（元に戻す）スタックの考慮
VBAによるプロパティの書き換えは、実行後に通常の「Ctrl + Z（元に戻す）」で復元することができない仕様になっている。そのため、本番環境で実行する前には、必ずマクロ側でファイルのバックアップ（別名保存など）を自動で行うラッパー処理を前段に挟むべきである。
② グループの深さとパフォーマンス
数千個のオブジェクトが入り組んだ複雑なSmartArtや巨大なCAD図面等が含まれるプレゼンテーションでは、再帰処理のオーバーヘッドがわずかに発生する。しかし、現代のVBAエンジンとメモリ管理下であれば数秒で完了するため、パフォーマンス上のボトルネックになることはほぼない。
③ プレースホルダーの扱いに関するポリシー策定
コード内の `ShouldCheckShape` 関数では、テキストプレースホルダーを検査対象外にしている。しかし、企業によっては「すべてのオブジェクト」に厳格な基準を求める場合がある。その場合は、`Case msoPlaceholder` の判定を外すことで、全要素を強制的にクレンジング対象に変更可能だ。組織のレギュレーションに合わせてこのフィルター関数をカスタマイズしてほしい。
—
総括
アクセシビリティの担保は、もはや「やれば丁寧な仕事」ではなく、企業のコンプライアンスおよび社会的責任（CSR）の領域である。
今回提供した自動化エンジンを組み込むことで、手作業によるヒューマンエラーを完全に排除し、一瞬で全スライドの品質を均一化することが可能になる。
退屈で消耗する作業はVBAにすべて押し付け、我々エンジニアは、より本質的でクリエイティブなシステム設計にそのリソースを傾けよう。
