PowerPoint VBAを掌握する極限の知見
第1回：SmartArtの深い森を迷わず抜けろ――内部テキスト再帰抽出・一括置換エンジンの設計
開発プロジェクトの現場で、こんな絶望を味わったことはないだろうか。
「全スライドの特定ワードを一括置換するスクリプトを書いた。よし、完璧だ」――だが、実行後に待っていたのは、無残にも取り残されたSmartArt内の古い製品名や、エラー落ちしたVBAの画面。
一般的なテキストボックスであれば `Shape.TextFrame.TextRange` を叩くだけで済む。しかし、SmartArtが絡んだ途端、PowerPointのオブジェクトモデルは牙をむく。SmartArtの内部は通常のシェイプツリーとは異なり、独自の「グループ化とノードの迷宮」によって構築されているからだ。
今回は、このSmartArtというブラックボックスを完全にハックし、内部テキストを安全かつ高速に再帰巡回・置換するプロダクションコードを授ける。表面的なコードの寄せ集めではなく、オブジェクトのライフサイクルとメモリ管理まで踏み込んだ「堅牢な設計」を体得してほしい。
—
1. なぜ通常の置換処理ではSmartArtを突破できないのか？
多くの初学者は、`ActivePresentation.Slides` をループさせ、`Slide.Shapes` の中身を片っ端から `Replace` しようとする。
だが、以下の構造的事実を知るべきだ。
1. `HasTextFrame` の裏切り: SmartArtの親シェイプ自体は、テキストフレームを持たない（あるいは持っていて空である）ケースが大半である。そのため、通常の `Shape.HasTextFrame` 判定ではスルーされる。
2. グループシェイプの多重構造: SmartArtは `Shape.Type = msoSmartArt` という固有の枚举を持つが、その実体はMicrosoft Office Graphic Architecture (MOGG) という特殊なエンジンで描画されている。
3. テキスト実体のありか: SmartArt内の文字を操作するには、`Shape.SmartArt.AllNodes` コレクションを直接イテレートするか、内部の `TextFrame2` にアクセスしなければならない。
これらを体系的に処理するためには、「SmartArtの判定」 と 「ノードの再帰的走査」 という二段構えのアーキテクチャが必要となる。
—
2. 堅牢な設計：バグを生まない3つの鉄則
実務で動くツールを作るにあたり、以下の設計思想をコードに組み込む。
- エラーハンドリングの局所化: 破損したSmartArtや、保護されたグループが存在しても、全体がクラッシュしないよう、個別のオブジェクトごとにエラーをハンドリングする。
- 値のイミュータブルな扱い（ではないが、参照の安全確保）: 置換処理は元の文字列構造を破壊しないよう、`.Text` プロパティではなく `.TextFrame2.TextRange` を安全にターゲットにする。
- パフォーマンスの最適化: 画面描画（`ScreenUpdating` 相当の挙動）や不要なオブジェクト生成を抑制し、数百枚のスライドであっても数秒で処理を完了させる。
—
3. 実装コード：SmartArtテキスト一括置換エンジン
以下のコードは、指定したキーワードを別のキーワードへ、通常のテキストボックスとSmartArtの双方を対象にシームレスに置換するプロシージャである。
標準モジュールにそのまま貼り付けて実行してほしい。
Option Explicit
‘ ==============================================================================
‘ 処理名 : プレゼンテーション全体のテキスト一括置換（SmartArt完全対応版）
‘ 概要 : 通常のテキストボックスに加え、SmartArt内部のノードテキストを
‘ 再帰的に走査し、指定キーワードを安全に置換する。
‘ ==============================================================================
Public Sub ReplaceTextInPresentationSmartArtAware()
Dim targetPresentation As Presentation
Set targetPresentation = ActivePresentation
‘ 置換設定（実務では入力フォームやセルから取得するように拡張してください）
Const FIND_KEYWORD As String = “旧プロジェクト名”
Const REPLACE_KEYWORD As String = “新プロジェクト名”
Dim sld As Slide
Dim shp As Shape
Dim replacedCount As Long
replacedCount = 0
‘ 画面描画を停止して処理速度を爆発的に向上させる
With Application
.ScreenUpdating = False
End With
On Error GoTo ErrorHandler
‘ 1. 全スライドを巡回
For Each sld In targetPresentation.Slides
‘ 2. スライド内の全シェイプを巡回
For Each shp In sld.Shapes
replacedCount = replacedCount + ProcessShape(shp, FIND_KEYWORD, REPLACE_KEYWORD)
Next shp
Next sld
Application.ScreenUpdating = True
MsgBox “置換処理が完了しました。” & vbCrLf & “総置換箇所数: ” & replacedCount & ” 箇所”, vbInformation, “完了”
Exit Sub
ErrorHandler:
Application.ScreenUpdating = True
MsgBox “予期せぬエラーが発生しました。” & vbCrLf & “Error: ” & Err.Description, vbCritical, “エラー”
End Sub
‘ ==============================================================================
‘ 関数名 : ProcessShape
‘ 概要 : シェイプの種別を判定し、分岐処理を行う（再帰のエントリポイント）
‘ ==============================================================================
Private Function ProcessShape(ByVal shp As Shape, ByVal findStr As String, ByVal replaceStr As String) As Long
Dim count As Long
count = 0
‘ 削除予定や非表示のシェイプはスキップ
If shp.Type = msoPlaceholder Then Exit Function
‘ パターンA: SmartArtの場合
If shp.Type = msoSmartArt Then
count = count + ReplaceSmartArtText(shp, findStr, replaceStr)
‘ パターンB: グループ化されたシェイプの場合（再帰処理）
ElseIf shp.Type = msoGroup Then
Dim subShp As Shape
For Each subShp In shp.GroupItems
count = count + ProcessShape(subShp, findStr, replaceStr)
Next subShp
‘ パターンC: 通常のテキストフレームを持つシェイプの場合
Else
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
count = count + ReplaceTextInRange(shp.TextFrame.TextRange, findStr, replaceStr)
End If
End If
End If
ProcessShape = count
End Function
‘ ==============================================================================
‘ 関数名 : ReplaceSmartArtText
‘ 概要 : SmartArtオブジェクトの全ノードを走査し、テキストを置換する
‘ ==============================================================================
Private Function ReplaceSmartArtText(ByVal shp As Shape, ByVal findStr As String, ByVal replaceStr As String) As Long
Dim node As SmartArtNode
Dim count As Long
count = 0
On Error Resume Next
‘ SmartArtのすべてのノード（階層構造を含む）を走査
For Each node In shp.SmartArt.AllNodes
If Not node.TextFrame2 Is Nothing Then
If node.TextFrame2.HasText Then
count = count + ReplaceTextInRange(node.TextFrame2.TextRange, findStr, replaceStr)
End If
End If
Next node
On Error GoTo 0
ReplaceSmartArtText = count
End Function
‘ ==============================================================================
‘ 関数名 : ReplaceTextInRange
‘ 概要 : TextRangeオブジェクトに対する置換を実行し、置換数を返す
‘ ==============================================================================
Private Function ReplaceTextInRange(ByVal txtRange As TextRange, ByVal findStr As String, ByVal replaceStr As String) As Long
Dim foundRange As TextRange
Dim count As Long
count = 0
‘ TextRange.Replace メソッドは置換が発生した回数を返す
‘ ※PowerPointのバグ（大文字小文字の区別や特殊文字）を回避するため、
‘ 必要に応じてMatchCaseやWholeWord引数を調整すること。
Do
Set foundRange = txtRange.Replace(FindWhat:=findStr, _
ReplaceWhat:=replaceStr, _
MatchCase:=msoTrue, _
WholeWords:=msoFalse)
If Not foundRange Is Nothing Then
count = count + 1
‘ 複数箇所の一括置換のためにレンジを更新
Set txtRange = txtRange.Characters(foundRange.Start + foundRange.Length, txtRange.Length – (foundRange.Start + foundRange.Length))
End If
Loop While Not foundRange Is Nothing
ReplaceTextInRange = count
End Function
—
4. チーフアーキテクトからの実務アドバイス
このコードを実務のデータベース連携システムや、ファイル自動生成バッチの一部として組み込む際には、以下の点に留意してほしい。
1. ADO / Excel連携への拡張:
硬直したコード内のキーワード指定ではなく、外部のExcelマスタ（「変更前」「変更後」の対応表）をADODBやExcelオブジェクト経由で読み込み、この置換エンジンにループで流し込む設計にすれば、数千枚におよぶコーポレート資料の統廃合・ブランディング変更（リブランディング）を一瞬で自動化できる。
2. パフォーマンスの限界:
SmartArtの `AllNodes` は、複雑な階層構造（組織図やプロセス図など）を持つ場合、想像以上にメモリを消費する。大規模なプレゼンテーションを処理する際は、適切なタイミングで `DoEvents` を挟むか、定期的にメモリのガベージコレクションを意識したオブジェクトの解放（`Set variable = Nothing`）を行うこと。
オブジェクトの構造を理解し、正しいレイヤーで再帰を回す。これができれば、PowerPoint VBAで自動化できないドキュメントの構造など存在しない。次のステージでは、さらに高度なシェイプ座標の自動再配置ロジックを解説しよう。
