最近、箇条書きや段落番号（番号書式）、アウトライン、見出しスタイルなどの検証をしており、その難しさや奥深さを体験しています。
この難しさの背景には、これらがすべて「リスト」と呼ばれる特殊なオブジェクトで作られているからです。
リストの扱いを間違えるとインデントがずれたり数字がずれたりします。インデントはけっこう簡単に崩れると感じます。みなさんはどう思いますか？
この記事では、このような文書を修正する際に役立つかもしれないマクロを紹介します。私はこのマクロを使ってリストの関係性がどのように変化するのか調べました。番号の修正にも役立つのではないかと思っています。
＜目次＞
リストのグループを可視化
番号の自動入力機能で番号にずれが生じるのには理由があります。
たとえば、リスト（段落番号やアウトライン）のグループが入れ子になり前後の関係がおかしくなっているときに、番号がずれることがあります。
この記事で紹介するマクロは、箇条書きの行頭文字や段落番号が自動入力された箇所をグループごとに色分けします。このことで、同一グループ、つまり番号の連続性のあるグループが、どのように配置されているのかを可視化できます。
このような情報があれば、一貫性を保つための修正作業もしやすくなると思いますので、Wordのオートナンバリング（連番の自動付与）機能をよく使う方はぜひお試しください。
このマクロでできること
Wordが認識するリストのグループを塗分けます。塗りつぶし（背景色）を用いるため、塗分ける色の種類は1600万もあります。
たくさんの項目が入れ子になった複雑なリストの場合でも塗分けられます。
下図の2つの買い物リストは見た目は同じですが、リストを構成する項目が異なります。
2つ目の買い物リストは同じ薄紫色になっており、1つのグループであることを示しています。１つのグループであれば、インデントなどの設定を一度の操作で行えます。
このような傾向が見えるだけで、リストの扱いが少し楽になります。表記や番号をそろえる操作を完全に自動化はできませんが、修正の方針を立てるときのヒントになると思います。
上記の図では箇条書きを紹介しましたが、段落番号やアウトラインも同様にグループごとに塗分けられます。また、ListNumフィールドを用いた箇所もリストとして特定し着色できます。
マクロの解説
1つ目のマクロで色を塗り分けます。
Wordではリストオブジェクトで、段落番号や行頭文字のある箇条書きだけでなく、アウトライン形式で番号が振られた箇所も特定できます。
私がこれまで「グループ」と呼んでいたのは1つのListオブジェクトのことです。6行目～16行目のループ処理で、それぞれのListオブジェクトを構成する項目を示すListParagraphオブジェクト（段落オブジェクト）の文字を同じ色で着色しています（11行目～13行目）。
2つ目のマクロ（GetRGBColorファンクション）で、背景色の色をランダムに設定しています。場合によっては、同じような色ばかりが使われてしまうことがありますから、グループをきれいに塗分けるまで何度か実行してみてください。
3つ目のマクロで文書の背景色を解除します。
いろいろサンプルファイルを作ってみてお試しください。
マクロ
Sub リストの塗分け_ランダム() Dim myDoc As Document: Set myDoc = ActiveDocument Dim i As Integer For i = 1 To myDoc.Lists.Count Dim myColor As Long: myColor = GetRGBColor With myDoc.Lists(i) Dim j As Integer For j = 1 To .CountNumberedItems Dim Para As Range: Set Para = .ListParagraphs(j).Range Para.End = Para.End - 1 '末尾の段落記号を除外 Para.Font.Shading.BackgroundPatternColor = myColor Next End With Next End Sub Private Function GetRGBColor() As Long 'r, g, b に0～255のランダム値を設定してRGBのLong値を返す 'ランダム値の設定方法は、以下の記事を参考にしました 'https://www.techonthenet.com/excel/formulas/rnd.php Dim r As Integer: r = Int(256 * Rnd) Dim g As Integer: g = Int(256 * Rnd) Dim b As Integer: b = Int(256 * Rnd) GetRGBColor = RGB(r, g, b) End Function Sub リストの塗分け_解除() ActiveDocument.Range.Font.Shading.BackgroundPatternColor = wdColorAutomatic End Sub