【再帰的探索】PowerPoint VBAの死角を突く：グループ化されたシェイプの内部を完全制覇する文字列置換ロジック
開発現場でよくある悲劇がある。
「スライド内の全テキストを一括置換するマクロ」を組み、テストでは完璧に動いたのに、いざ本番で運用すると「一部の文字が置き換わっていない」というクレームが届く。
原因は明白だ。その文字列は、グループ化されたシェイプ（GroupShapes）の奥底に眠っていた。
素人が書いた浅いループは、`ActivePresentation.Slides(1).Shapes` の表層しか舐めない。PowerPoint VBAのオブジェクトモデルにおいて、グループ化された図形は「別のコンテナ」として存在し、通常の `Shapes` コレクションの網から完全に漏れる仕様になっているからだ。
今回は、このPowerPointの構造的罠を粉砕し、多重ネストされたグループの最深部まで確実に到達してテキストを置換する「再帰的探索（Recursive Search）ロジック」を授けよう。
—
1. なぜ通常のループでは失敗するのか？
PowerPointのオブジェクトモデルにおいて、`Slide.Shapes` はフラットなコレクションに見えて、実は階層構造を持っている。
[Slide]
┗ [Shapes]
┣ Shape 1 (通常テキスト)
┣ Shape 2 (通常テキスト)
┗ Shape 3 (グループ)
┗ [GroupItems]
┣ Shape 3-1 (ここにターゲットがある！)
┗ Shape 3-2 (さらにグループ…)
┗ [GroupItems]
┗ Shape 3-2-1
`Shape 3` がグループである場合、その中にある子シェイプには `Shape.GroupItems` を経由しなければアクセスできない。しかも、グループの中に「さらにグループがある（多重ネスト）」という悪夢のようなレイアウトも実務では日常茶飯事だ。
これを力技の `For` ループで書こうとすると、ネストの階層分だけループを深く書く必要があり、無限の階層に対応できない。ここで「再帰関数（自分自身を呼び出す関数）」の出番となる。
—
2. 堅牢な再帰ロジック設計の要件
実務の現場で耐えうるコードを書くには、以下の3点を死守せよ。
1. 型安全性の担保 (`TypeOf`演算子)
すべてのシェイプがテキストを持っているわけではない。また、グループシェイプ自体はテキストフレーム（`TextFrame`）を持たない場合があるため、プロパティアクセス時のエラーを完全にガードする。
2. 無限ループの防止
構造上の循環参照は通常起こり得ないが、想定外のCOM例外に対して `On Error Resume Next` の乱用を避け、適切なエラーハンドリングを行う。
3. 参照渡しのパフォーマンス
オブジェクトの走査は重い。無駄なインスタンス生成を避け、メモリ効率を意識した設計にする。
—
3. 【プロダクションコード】完全網羅型・テキスト一括置換エンジン
以下のコードを標準モジュールに貼り付けてほしい。
スライド内の通常のテキストボックス、表、プレースホルダー、そして何重にもネストされたグループ内のテキストまで、漏れなく検索・置換するプロフェッショナル向けの実装だ。
Option Explicit
‘ =========================================================================
‘ 実行エントリーポイント
‘ =========================================================================
Public Sub ExecuteDeepTextReplacement()
Dim targetPresentation As Presentation
Set targetPresentation = ActivePresentation
Dim targetString As String
Dim replacementString As String
‘ 検索・置換ワードの設定（実務ではInputBoxや外部DB/Excel連携に拡張可能）
targetString = “【旧会社名】”
replacementString = “【新会社名】”
Dim modifiedCount As Long
modifiedCount = 0
Dim sld As Slide
Dim shp As Shape
‘ 画面描画を停止してパフォーマンスを極限まで引き上げる
With Application
.ScreenUpdating = False
.Cursor = ppCursorWait
End With
On Error GoTo ErrorHandler
‘ 全スライドを走査
For Each sld In targetPresentation.Slides
For Each shp sld.Shapes
‘ 再帰プロシージャを呼び出し
ProcessShapeRecursive shp, targetString, replacementString, modifiedCount
Next shp
Next sld
MsgBox “置換処理が完了しました。” & vbCrLf & _
“更新されたテキスト要素数: ” & modifiedCount & ” 箇所”, _
vbInformation, “一括置換完了”
CleanUp:
With Application
.ScreenUpdating = True
.Cursor = ppCursorDefault
End With
Exit Sub
ErrorHandler:
MsgBox “予期せぬエラーが発生しました: ” & Err.Description, vbCritical, “エラー”
Resume CleanUp
End Sub
‘ =========================================================================
‘ 再帰的シェイプ探索プロシージャ
‘ =========================================================================
Private Sub ProcessShapeRecursive(ByVal shp As Shape, ByVal target As String, ByVal repl As String, ByRef count As Long)
On Error GoTo SafeExit
‘ 1. グループ化されたシェイプの場合の処理
If shp.Type = msoGroup Then
Dim subShp As Shape
‘ グループ内の各アイテムに対して自分自身を再帰呼び出し
For Each subShp In shp.GroupItems
ProcessShapeRecursive subShp, target, repl, count
Next subShp
Exit Sub
End If
‘ 2. 通常のシェイプ（テキストフレームを持つ場合）の置換処理
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
If ReplaceTextInTextRange(shp.TextFrame.TextRange, target, repl) Then
count = count + 1
End If
End If
End If
‘ 3. 表（Table）内部のセルにテキストが存在する場合の処理
If shp.HasTable Then
Dim rowIdx As Long, colIdx As Long
Dim tbl As Table
Set tbl = shp.Table
For rowIdx = 1 to tbl.Rows.Count
For colIdx = 1 to tbl.Columns.Count
If tbl.Cell(rowIdx, colIdx).Shape.HasTextFrame Then
If tbl.Cell(rowIdx, colIdx).Shape.TextFrame.HasText Then
If ReplaceTextInTextRange(tbl.Cell(rowIdx, colIdx).Shape.TextFrame.TextRange, target, repl) Then
count = count + 1
End If
End If
End If
Next colIdx
Next rowIdx
End If
SafeExit:
‘ COMオブジェクト特有の予期せぬエラーをサイレントにスルー（ログ出力等に拡張可）
Exit Sub
End Sub
‘ =========================================================================
‘ TextRange内の文字列置換実務ロジック
‘ =========================================================================
Private Function ReplaceTextInTextRange(ByVal txtRange As TextRange, ByVal target As String, ByVal repl As String) As Boolean
Dim foundRange As TextRange
Dim isReplaced As Boolean
isReplaced = False
‘ PowerPointのFindを使うことで、書式を保持したまま文字列置換が可能
Set foundRange = txtRange.Find(Find:=target, After:=0, MatchCase:=msoTrue, WholeWords:=msoFalse)
Do While Not foundRange Is Nothing
foundRange.Text = repl
isReplaced = True
‘ 次の一致を検索（無限ループ防止のため、レンジの終端以降を検索）
Dim nextStart As Long
nextStart = foundRange.Start + Len(repl)
If nextStart > txtRange.Length Then Exit Do
Set foundRange = txtRange.Find(Find:=target, After:=nextStart, MatchCase:=msoTrue, WholeWords:=msoFalse)
Loop
ReplaceTextInTextRange = isReplaced
End Function
—
totalPages
—
4. チーフアーキテクトが教える、実務運用上の注意点
このコードを実際のビジネスプロセス（RPA連携、Excelマスタからのデータ流し込み、大量のプレゼン資料の自動生成など）に組み込む際、以下の設計思想を忘れてはならない。
① 画面描画のロック (`ScreenUpdating = False`) は絶対
再帰処理はオブジェクトの数だけメモリとCPUを消費する。PowerPointは図形が更新されるたびに画面を描画しようとするため、この処理をオフにするだけで実行速度が最大10倍以上変わる。実務では必須のイディオムだ。
② 表（Table）やSmartArtの罠
今回のコードでは `HasTable` を網羅しているが、実務では「SmartArtの内部テキスト」もグループの亜種として存在することがある。SmartArtは原則としてXML構造に近く、VBAからの直接操作は不安定になりがちだ。もしSmartArt内部まで完璧に置換したい場合は、一度テキストに変換するか、XML（OpenXML）レイヤーでの操作を検討すべきである。
③ データベースやExcel連携への発展
今回のサンプルでは置換文字列をハードコーディングしているが、実務ではExcelの「置換リスト（A列：検索ワード、B列：置換ワード）」を読み込み、ループさせながら上記の再帰エンジンを回すのが定石だ。
大規模なデータ連携を行う際は、エラーハンドリング内で「どのスライドのどのシェイプでエラーが起きたか」をイミディエイトウィンドウやログファイルに出力するデバッグ機構を必ず付加すること。
—
総括
「グループ化の奥底にあるシェイプに届かない」というPowerPoint VBAの仕様の壁は、再帰関数（Recursive Function）という正しい武器を使えば容易に突破できる。
コードをコピペして動かすだけにとどまらず、「なぜこの構造が必要なのか」のコンテキストを理解し、あなたの現場の自動化ツールを一段上のフェーズへと引き上げてほしい。
