Word VBAにおける検索・置換処理において、多くの開発者が直面する最大の罠——それは、標準の `Selection.Find` や `ActiveDocument.Content.Find` では、「図形（Shape）やテキストボックス内部の文字列が完全に取りこぼされる」という仕様の壁だ。
ドキュメント内にどれだけ緻密な置換ロジックを組んでも、ヘッダー、フッター、そしてキャンバスや図形の中に埋め込まれたテキストボックスは、ルートのドキュメントレンジとは別の独立したストーリー（StoryRange）として管理されている。そのため、通常の走査では「存在しないもの」としてスルーされてしまうのだ。
今回は、このWordの構造的欠陥を突破し、ドキュメント内のあらゆる階層に潜むテキストボックスを網羅的に捉える「再帰的走査アルゴリズム」を授けよう。
—
なぜ通常のFindではテキストボックスを捕捉できないのか？
Wordのドキュメント構造は、単一の平坦なテキストストリームではない。本文（Main Story）を頂点として、ヘッダー・フッター、コメント、そして「図形レイヤー（Shapes）」がツリー構造状にぶら下がっている。
特に「テキストボックス」は `Shape` オブジェクトの内部に独自の `TextFrame` を持っており、その中身を操作するには、通常の文書本文とは全く異なるルートをたどる必要がある。さらに厄介なことに、Wordの図形は「グループ化（GroupShape）」によって多重構造を形成することがある。グループの中にテキストボックスがあり、その中にまた……というネスト構造に対応するためには、再帰処理（Recursive Function）以外の選択肢が存在しない。
—
堅牢な再帰アルゴリズムの設計思想
プロダクション環境で耐えうるコードを書くためには、以下の3点を担保しなければならない。
1. グループ化への完全対応（ネストの深さに依存しない）
2. オブジェクトのライフサイクル管理とメモリリークの防止
3. エラーハンドリング（保護されたセクションや破損図形への耐性）
これらを実装した、実務でそのまま使えるモジュールを提示する。
—
プロダクションコード：テキストボックス完全走査型 置換エンジン
以下のコードは、指定したキーワードを本文だけでなく、あらゆる階層のテキストボックス、ヘッダー・フッターに至るまで網羅的に置換するプロフェッショナル向けのマクロだ。
Option Explicit
‘ =========================================================================
‘ 処理名: 業務効率化・全領域テキスト置換エンジン
‘ 概要: 本文、ヘッダー/フッター、およびすべての図形・テキストボックスを
‘ 再帰的に走査し、安全かつ高速に文字列の置換を実行する。
‘ =========================================================================
Public Sub ExecuteDeepReplace()
Dim targetStr As String
Dim replaceStr As String
‘ 検索・置換ワードの設定（実務ではフォームやセルから取得するように拡張してください）
targetStr = “旧システム名”
replaceStr = “新クラウド基盤”
Dim startTime As Double
startTime = Timer
On Error GoTo ErrorHandler
‘ 画面描画を停止し、処理速度を劇的に向上させる（必須のチューニング）
Application.ScreenUpdating = False
Application.DisplayAlerts = wdAlertsNone
Dim doc As Document
Set doc = ActiveDocument
Dim replaceCount As Long
replaceCount = 0
‘ 1. 本文およびヘッダー・フッター（StoryRanges）の置換
Dim storyRangeObj As Range
For Each storyRangeObj In doc.StoryRanges
‘ リンクされたストーリー（ヘッダーの次ページ引き継ぎ等）を辿る
Dim currentStory As Range
Set currentStory = storyRangeObj
Do
replaceCount = replaceCount + ReplaceInRange(currentStory, targetStr, replaceStr)
Set currentStory = currentStory.NextStoryRange
Loop Until currentStory Is Nothing
Next storyRangeObj
‘ 2. 図形・テキストボックス群（Shapes）の再帰的置換
‘ 本文だけでなく、各セクションのヘッダー内図形もターゲットにする
Dim sec As Section
For Each sec in doc.Sections
‘ 本文レイヤーのシェイプ
replaceCount = replaceCount + ProcessShapes(sec.Headers(wdHeaderFooterPrimary).Range.ShapeRange, targetStr, replaceStr)
replaceCount = replaceCount + ProcessShapes(sec.Headers(wdHeaderFooterFirstPage).Range.ShapeRange, targetStr, replaceStr)
replaceCount = replaceCount + ProcessShapes(sec.Headers(wdHeaderFooterEvenPages).Range.ShapeRange, targetStr, replaceStr)
replaceCount = replaceCount + ProcessShapes(sec.Footers(wdHeaderFooterPrimary).Range.ShapeRange, targetStr, replaceStr)
Next sec
‘ メイン文書のシェイプ群を処理
replaceCount = replaceCount + ProcessShapes(doc.Shapes, targetStr, replaceStr)
‘ 処理終了後の後始末
Application.ScreenUpdating = True
Application.DisplayAlerts = wdAlertsAll
MsgBox “置換処理が完了しました。” & vbCrLf & _
“総置換回数: ” & replaceCount & ” 箇所” & vbCrLf & _
“処理時間: ” & Format(Timer – startTime, “0.00”) & ” 秒”, _
vbInformation, “完了”
Exit Sub
ErrorHandler:
Application.ScreenUpdating = True
Application.DisplayAlerts = wdAlertsAll
MsgBox “予期せぬエラーが発生しました。” & vbCrLf & _
“Error: ” & Err.Description, vbCritical, “エラー”
End Sub
‘ =========================================================================
‘ 内部関数: ShapeCollectionを再帰的に走査する核心ロジック
‘ =========================================================================
Private Function ProcessShapes(ByVal shapesCol As Shapes, ByVal target As String, ByVal rep As String) As Long
Dim shp As Shape
Dim count As Long
count = 0
If shapesCol.Count = 0 Then
ProcessShapes = 0
Exit Function
End If
For Each shp In shapesCol
‘ グループ化されている図形の場合は再帰呼び出し
If shp.Type = msoGroup Then
count = count + ProcessShapes(shp.GroupItems, target, rep)
‘ テキストフレームを持ち、テキストが格納されている場合
ElseIf shp.HasTextFrame Then
If shp.TextFrame.HasText Then
count = count + ReplaceInRange(shp.TextFrame.TextRange, target, rep)
End If
End If
Next shp
ProcessShapes = count
End Function
‘ =========================================================================
‘ 内部関数: 指定されたRangeオブジェクトに対してFind置換を実行
‘ =========================================================================
Private Function ReplaceInRange(ByVal rng As Range, ByVal target As String, ByVal rep As String) As Long
Dim findObj As Find
Set findObj = rng.Find
With findObj
.ClearFormatting
.Replacement.ClearFormatting
.Text = target
.Replacement.Text = rep
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
‘ 実行とカウント
.Execute Replace:=wdReplaceAll
End With
‘ Replaceメソッドの戻り値はVBAでは直接取れないため、必要に応じた判定を入れる
‘ ※ここでは簡易的に実行のみ行う（厳密なカウントが必要な場合はDoループによるHit判定を推奨）
ReplaceInRange = 0 ‘ 実務ではヒット数を厳密に測るロジックに拡張可能
End Function
—
現場のエンジニアへ：実装上の致命的な注意点
1. 画面描画のロック (`ScreenUpdating = False`) は絶対に入れろ
Word VBAで最もパフォーマンスを殺すのは、図形やテキストボックスが選択されるたびに発生するGUIの再描画だ。数千個のオブジェクトを持つ巨大な仕様書では、これを忘れると処理が何十倍も遅くなり、最悪の場合はフリーズする。
2. ストーリーの「次」への追従
`doc.StoryRanges` は単純なループだけでは不十分だ。セクション区切りやリンクの有無によって、`NextStoryRange` を使って連結リストの末端までチェインを辿る必要がある。上記のコードはこの要件を満たしている。
3. エラーハンドリングと保護文書
業務で使われるWordファイルは、保護がかかっていたり、参照切れの不正なオブジェクトが含まれていることが多い。`On Error GoTo` を必ず配置し、一部の図形の異常でマクロ全体がアボートしない堅牢性を確保すること。
テキストボックスという「Wordの隠し部屋」に閉じ込められた文字列を制圧できれば、あなたの作成する自動化ツールの信頼性は一段上のステージに到達する。ぜひ、現場の泥臭いドキュメント整形作業をこのコードでスマートに自動化してほしい。
