以前の記事「【コード】特許明細書の段落番号を連番にする」で、和文の特許明細書の段落番号を連続番号に変更するマクロを紹介しました。
最近、お客様から、特定の開始番号に設定したいとの要望をいただきましたので作ってみました。
今後、このマクロをWordで動く翻訳チェックソフト「色deチェック」 に実装します。
今回紹介するマクロは、前回の記事に掲載されたマクロをベースにしていますが、オブジェクト変数を利用したり、段落番号の表記方法を変更したり若干修正してあります。
＜目次＞
このマクロでできること
和文の特許明細書に対して実行します。
段落番号の前に全角や半角のスペースが入っていたり、入っていなかったり。
また、タブが入っている場合もあるかもしれません。
（実行前）
（開始番号を指定）
全角でも半角でもかまいません。数字を入力します。
（実行後）
指定した番号から番号が振り直されます。
また、段落番号の直前に全角スペースが1つ挿入されるよう書式を統一します。
マクロの解説
IsNumeric関数を用いています。このインプットボックスでひらがなを入力しても元の入力画面に戻ります。
17行目でString型で受けた値を、Integer型に型変換しています。この工程がなくてもVBAでは自動的に型変換しますが、このマクロでは明示しました。
最初のワイルドカードを使用した置換で、段落番号の表記を統一します。
検索する文字列
"^13[ ^t]{1,}(【[0-9０-９＠]{4}】)"
置換後の文字列
"^p\1"
新たに挿入する段落番号の書式を、60行目で設定します。
ここで、StrConv関数を使って数字を全角にしたり、段落先頭に全角スペースを入れたり設定しています。
myNumber = " 【" & StrConv(Format(i, "0000"), vbWide) & "】"
好みの書式に変更してみてください。
マクロ
Sub 段落番号を連番_和文()
Dim iStart As String
Dim i As Integer
Dim myNumber As String '墨付き括弧付きの4桁の全角段落番号
Dim myRange As Range
Const myTitle As String = "【和文】特許明細書の段落番号の連番マクロ"
Const myMessage As String = "開始番号を入力してください"
'連番の初期値を設定
Do
iStart = InputBox(myMessage, myTitle, 1)
If iStart = vbNullString Then Exit Sub
Loop While IsNumeric(iStart) = False
'型変換（StringからIntegerへ）
i = CInt(iStart)
'オブジェクト変数の設定
Set myRange = ActiveDocument.Range(0, 0)
'段落先頭の段落番号の表記を統一
With myRange.Find
.Text = "^13[ ^t]{1,}(【[0-9０-９＠]{4}】)"
.Replacement.Text = "^p\1"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False '大文字と小文字の区別する
.MatchWholeWord = False '完全に一致する単語だけを検索する
.MatchByte = False '半角と全角を区別する
.MatchAllWordForms = False '英単語の異なる活用形を検索する
.MatchSoundsLike = False 'あいまい検索（英）
.MatchFuzzy = False 'あいまい検索（日）
.MatchWildcards = True 'ワイルドカードを使用する
.Execute Replace:=wdReplaceAll
DoEvents
End With
'myRangeを文書先頭に移動
myRange.SetRange Start:=0, End:=0
'段落先頭の段落番号を検索する条件を設定
With myRange.Find
.Text = "^13【[0-9０-９＠]{4}】"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False '大文字と小文字の区別する
.MatchWholeWord = False '完全に一致する単語だけを検索する
.MatchByte = False '半角と全角を区別する
.MatchAllWordForms = False '英単語の異なる活用形を検索する
.MatchSoundsLike = False 'あいまい検索（英）
.MatchFuzzy = False 'あいまい検索（日）
.MatchWildcards = True 'ワイルドカードを使用する
'段落先頭の段落番号が見つかる間実行する
Do While .Execute = True
'全角で段落番号を入力
myNumber = " 【" & StrConv(Format(i, "0000"), vbWide) & "】"
With myRange
.Text = vbCr + myNumber
.Collapse wdCollapseEnd
End With
'i の値を1つ増加
i = i + 1
Loop
End With
Set myRange = Nothing
End Sub