以前、和文の段落番号を連続番号に処理をするマクロを紹介しました。
お客様から英文の段落番号の処理のご要望を受けまして、作ってみました。
Wordで動く翻訳チェックソフト「色deチェック」にはすでに同様の機能がありますが、同じマクロをここで紹介しても面白くありません。
今回のマクロでは、「選択範囲」に処理対象を限定した機能を紹介します。
このマクロでできること
選択範囲内の英文特許明細書用の段落番号を指定した番号から連続番号処理をします。
（実行前）
対象範囲を選択します。開始する段落番号の直前の改行記号も選択してください。
以下の例のように段落暗号の直前にタブや半角スペースが挿入されていてもかまいません。
マクロを実行して、開始番号を指定します。以下の例では20を入力しました。
（マクロ実行後）
連続番号になります。また表記も統一されます。
マクロの解説
ワイルドカードを用いて、段落番号直前の半角スペースやタブ記号を削除しています。（30行目、31行目）
表記の統一にはけっこう使える考え方だと思うので、真似をしてみてください。
処理対象の範囲を選択範囲に限定するための仕組みは、24行目、51行目、72行目に記載されています。
24行目で、まずは処理対象をオブジェクト変数のmyRangeに設定します。
51行目では、myRangeと同じ範囲を別のオブジェクト変数のmyInRangeに設定します。
72行目では、このmyInRangeを用いて検索した段落番号（myRange）が所定の範囲（myInRange）に入っているのかを判定しています。
マクロ
Sub 段落番号を連番_英文_範囲指定()
Dim iStart As String
Dim i As Integer
Dim myNumber As String '墨付き括弧付きの4桁の全角段落番号
Dim myRange As Range
Dim myInRange 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 = Selection.Range
'-------------------------------------------
'前処理（段落先頭の段落番号の表記を統一）
'-------------------------------------------
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をmyInRangeに設定
Set myInRange = myRange.Duplicate
'段落先頭の段落番号を検索する条件を設定
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
'選択範囲内であれば処理を実行
If myRange.InRange(myInRange) = True Then
'半角で段落番号を入力
myNumber = "[" & Format(i, "0000") & "]"
With myRange
.Text = vbCr + myNumber
.Collapse wdCollapseEnd
End With
'i の値を1つ増加
i = i + 1
Else
Exit Do
End If
Loop
End With
'-------------------------------------------
'後処理
'-------------------------------------------
Set myRange = Nothing
Set myInRange = Nothing
End Sub
