【Word VBAを掌握する極限の知見】段落の「行間」を固定値（pt）で一括指定し、複数文書のレイアウトを強制的に統一する
レガシーシステムの保守、あるいは複数ベンダーや不特定多数の従業員が作成したWord文書の取りまとめにおいて、最大のボトルネックは「レイアウトの揺れ」である。
特にフォントサイズと行間の関係がバラバラな文書群をそのまま社外報や公式ドキュメントとして流通させることは、企業ガバナンス上、許されない。
GUIのマウス操作でこれを修正するなど、エンジニアの工数の無駄遣いだ。
今回は、Word VBAのオブジェクトモデルの深層にアプローチし、数千ページ規模の文書であっても瞬時に、かつミリ単位（ポイント単位）で厳密に行間を固定値化する実務コードと、その裏にあるアーキテクチャの知見を解説する。
—
1. なぜ「固定値（pt）」による制御が必要なのか
Wordのデフォルト設定（「1行」や「1.15行」など）は、基準となるフォントのメトリクスに依存して動的に算出される。そのため、ユーザーが知らず知らずのうちに異なるフォントファミリーやサイズを混在させると、行の高さがガタガタになり、印刷プレビューやPDF変換時に致命的なレイアウト崩壊を引き起こす。
プロフェッショナルな文書自動化において、レイアウトの決定権をアプリケーション側からコード側へ完全に剥奪し、「固定値（wdLineSpaceExactly）」としてハードコードすることが、予期せぬ事故を防ぐ唯一の解となる。
—
2. Word VBA アーキテクチャの核心：オブジェクトのライフサイクルとパフォーマンス
実務で数万行に及ぶ段落を走査する際、漫然とコードを書くとWordのCOMインターフェースとのラウンドトリップ（往復通信）が多発し、処理がフリーズしたかのような重さに陥る。
チーフアーキテクトとして、以下の3点をコードに実装しなければならない。
1. 画面描画の完全な抑制 (`ScreenUpdating`)：DOMの再描画コストを完全に遮断する。
2. オブジェクトの明示的解放：VBAのガベージコレクションへの過度な依存を断ち切り、メモリリークを防ぐ。
3. エラーハンドリングの堅牢性：保護されたセクションやテーブル内の特殊な段落構造に対する耐性の確保。
—
3. 実装コード：一括レイアウト強制統一エンジン
以下のコードは、指定したフォルダ内、あるいは現在アクティブな文書の全段落に対し、行間を強制的に「固定値（例: 18pt）」に上書きするプロダクションレベルのマクロである。
Option Explicit
‘ ==============================================================================
‘ 処理名: 複数/単体文書の段落行間「固定値」強制統一エンジン
‘ 著 者: チーフアーキテクト
‘ 概要: ドキュメント内の全段落（ストーリー、表内を含む）の行間を
‘ 指定したポイント数の固定値へ一括変換する。
‘ ==============================================================================
Sub ForceLineSpacingToExact()
Dim startTime As Double
startTime = Timer
‘ 1. パフォーマンス最適化の極限設定
With Application
.ScreenUpdating = False
.DisplayAlerts = wdAlertsNone
.AutomationSecurity = msoAutomationSecurityForceDisable
CG = .Cursor
.Cursor = wdCursorWait
End With
On Error GoTo ErrorHandler
Dim targetDoc As Document
Set targetDoc = ActiveDocument ‘ 必要に応じてFilesystemオブジェクト等で拡張可能
‘ 2. パラメータ定義（必要に応じて変更せよ）
Const TARGET_LINE_SPACING_PT As Single = 18# ‘ 行間固定値 (ポイント)
Const TARGET_SPACE_AFTER_PT As Single = 4# ‘ 段落後スペース (ポイント)
Dim pCount As Long
pCount = 0
‘ 3. メイン処理：ストーリー全体（ヘッダー、フッター、本文、テキストボックス、表内）を走査
Dim rngStory As Range
For Each rngStory In targetDoc.StoryRanges
Dim currentRange As Range
Set currentRange = rngStory
Do
‘ 物語（Story）の連鎖を辿るためのループ処理
Call ApplyExactSpacingToRange(currentRange, TARGET_LINE_SPACING_PT, TARGET_SPACE_AFTER_PT, pCount)
Set currentRange = currentRange.NextStoryRange
Loop Until currentRange Is Nothing
Next rngStory
‘ 4. 完了通知とパフォーマンス復元
Application.ScreenUpdating = True
Application.Cursor = wdCursorDefault
Application.DisplayAlerts = wdAlertsAll
MsgBox “レイアウトの強制統一が完了しました。” & vbCrLf & _
“処理対象段落数: ” & pCount & ” 箇所” & vbCrLf & _
“処理時間: ” & Format(Timer – startTime, “0.00”) & ” 秒”, _
vbInformation, “architecture Engine Active”
Exit Sub
ErrorHandler:
‘ 異常系ハンドリング：COM例外の捕捉とリソースの強制解放
Application.ScreenUpdating = True
Application.Cursor = wdCursorDefault
Application.DisplayAlerts = wdAlertsAll
MsgBox “致命的なエラーが発生しました。” & vbCrLf & _
“Error No: ” & Err.Number & vbCrLf & _
“Description: ” & Err.Description, _
vbCritical, “System Error”
‘ オブジェクトの明示的破棄
Set targetDoc = Nothing
Set rngStory = Nothing
Set currentRange = Nothing
End Sub
‘ ——————————————————————————
‘ 内部プロシージャ: 範囲指定されたオブジェクトに対する書式適用
‘ ——————————————————————————
Private Sub ApplyExactSpacingToRange(ByRef targetRange As Range, ByVal lineSpacePt As Single, ByVal spaceAfterPt As Single, ByRef processedCount As Long)
Dim para As Paragraph
For Each para In targetRange.Paragraphs
‘ 保護された文書やフォームフィールド内でのエラー回避
On Error Resume Next
With para
‘ 行間の種類を「固定値 (wdLineSpaceExactly)」に設定
.LineSpacingRule = wdLineSpaceExactly
‘ ポイント数を指定 (PointsToLinesではなく、PointsToPoints換算を使用)
.LineSpacing = Application.CentimetersToPoints(lineSpacePt / 28.3464567) ‘ もしくは直接 Point 換算関数を使用
‘ ※Word VBAの仕様上、LineSpacingに直接数値を代入すると「ポイント」として解釈されるケースが多いが
‘ 確実性を期すため、Pt値をそのまま渡すか、内部関数を用いる。
.LineSpacing = PtToPointsCustom(lineSpacePt)
‘ ついでに段落後の空きも統一
.SpaceAfter = PtToPointsCustom(spaceAfterPt)
End With
If Err.Number = 0 Then
processedCount = processedCount + 1
End If
On Error GoTo 0
‘ 巨大文書でのメモリ枯渇を防ぐための解放配慮
Set para = Nothing
Next para
End Sub
‘ ——————————————————————————
‘ ユーティリティ: ポイントから内部単位への確実な変換ラッパー
‘ ——————————————————————————
Private Function PtToPointsCustom(ByVal pt As Single) As Single
‘ Wordのネイティブ内部単位は「ポイント (1pt = 20 ティップス)」だが、
‘ .LineSpacingプロパティへ代入する際はそのままの数値（Pt）で受け付けられる。
PtToPointsCustom = pt
End Function
—
4. チーフアーキテクトからの実践的アドバイス
1. `StoryRanges` の罠を見抜け
単に `ActiveDocument.Paragraphs` をループさせるだけでは、ヘッダー、フッター、図形内のテキストボックス、そして表（Table）のセル内部にある段落が漏れ落ちる。上記のコードのように `StoryRanges` を網羅的に辿るアーキテクチャこそが、真の「一括統一」を担保する。
2. フォントメトリクスとの競合に注意
行間を「固定値」にした場合、指定したポイント数よりも大きなフォントサイズがその段落内に混入すると、文字の上部・下部が強制的に切り捨てられて表示される。この自動化スクリプトを実行する前提条件として、「フォントサイズも同時に統一する（あるいは上限を設ける）」設計にしておくことが、実務におけるシステム運用上の鉄則である。
妥協のないコードとアーキテクチャの理解こそが、あなたの業務を自動化の地獄から救い出す唯一の武器となる。
