【WordVBA】条文の概要と条数とを1行にする

e-Govの法令検索では、法の条文は次のようになっています。

労働基準法第1条

図で解説すると、こんな感じです。

法令検索における条文の図解

これをそのまま使うと何が不便かというと、Wordでの目次作成や参照設定の際、困るのです。

そこで、こうしたいと思います。

今回労働基準法を例に説明していますが、私が実際に使っているのは、就業規則を作るときです。

就業規則の参照先条数がよく間違っていますよね。改廃をかさねていくと、手動でやっているとどうしても漏れが出てしまいます。あれをどうにかしたくてWordのスタイルや段落設定やアウトラインレベルを駆使しているのですが、手動でちまちまやるのがめんどくさくなってきたので、少しマクロを書いて作業のいくつかを自動化することにしました。

今回ご紹介するのはそのうちの一部です。

機能

こう↓なっているのを

(労働条件の原則)

第1条 労働条件は、労働者が人たるに値する生活を営むための必要を充たすべきものでなければならない。

このように↓変更します。

第1条(労働条件の原則)

① 労働条件は、労働者が人たるに値する生活を営むための必要を充たすべきものでなければならない。

第○○条の数字の部分は、アラビア数字になっている必要があります。

漢数字をアラビア数字に変換するマクロについてはこちらを参照してください。

あらかじめ選択されている場合は、選択された範囲内のみ変換します。何も選択されていない場合は、文書全体を検索して変換します。

途中に表が含まれる場合、レイアウトが崩れますので、表がある場合は表を避けて選択してからマクロを使ってください。

かっこ()は全角です。半角のかっこだと検索条件にヒットしません。

コード

コードはこちらです。

Public Sub 概要と条文とを1行にする()
    
    Dim rng As Range
    
    '変換範囲
    If Selection.Start = Selection.End Then
        Set rng = ActiveDocument.Range   '範囲選択しなければ文書全体
    Else
        Set rng = Selection.Range    '選択された範囲内のみ
    End If

    Dim reg As Object
    Set reg = CreateObject("VBScript.RegExp")   '正規表現用オブジェク生成
    reg.Pattern = "((.+?))" & vbCr & "(第\d+条)" '(で始まり)で終わり第○○条と続く部分
    reg.Global = True
    
    Dim Match As Object
    For Each Match In reg.Execute(rng.Text)
        rng.Text = Replace(rng.Text, Match.Value, Match.SubMatches(1) & Match.SubMatches(0) & vbCr & "①")
        rng.Text = Left(rng.Text, Len(rng.Text) - 2) '文章末にできる不要な改行コード二つを削除
    Next Match
    
    Set reg = Nothing
    Set rng = Nothing
End Sub

解説

正規表現部分について軽く解説しておきます。

reg.Pattern = "((.+?))" & vbCr & "(第\d+条)" '先頭が(で始まり文末が)で終わり第○○条と続く部分

“((.+?))”は、()かっこで囲まれた文字列の意味です。正規表現のグループを意味するかっこは半角ですが、中身のかっこは全角です。

.(ピリオド)は文字だったら何でもの意味のワイルドカードです。+?は直前の要素と 1 回以上 (ただし、できるだけ少ない回数) 一致することを意味する量指定子です。

vbCrはWordにおける改行コードです。最初vbCrLfで試したところ反応しなかったので、vbCrにしてみました(超適当です^^;私のコーディングはこんなものです^^;)。

“(第\d+条)”は、第○○条の部分の意味です。\dは整数を意味します。

それぞれ半角かっこ()でくくっているので、ヒットしたとき変数MatchのSubMatchesコレクションにヒットした値が入ります。今回は2要素分ですので、コレクション数は2となります。

マクロ実行中のローカルウィンドウ。MatchのSubMatchesのItemが二つあり、Item1が(労働条件の原則)、Item2が第1条となっていることが分かる。

SubMatchesコレクションのItemを取り出すときは0起算です。うっかり1起算だと勘違いして、しばらくエラーに悩みました。

rng.Text = Replace(rng.Text, Match.Value, Match.SubMatches(1) & Match.SubMatches(0) & vbCr & "①")

↑これはReplaceでヒット個所を置換しています。

置換後の文字列は、Match.SubMatches(1) & Match.SubMatches(0) & vbCr & “①”です。

Item2を先に、Item1を後ろに持ってきて、改行コードvbCRを挟んで、①を付与しています。

おまけ

今回ご紹介したコードが入ったマクロ入りWord文書をZIPにして置いておきます。著作権については放棄していませんが、たいした内容ではないと思うので、改修再配布はご自由にどうぞ。またご利用は自己責任でお願いします。コードを実行した結果損害が発生したとしても、当方では責任を負えませんので悪しからず。

https://kn-sharoushi.com/wp-content/uploads/2023/04/概要と条文とを1行にする.zip