前回の記事「【Word】法務文書の条番号の表記を統一するワイルドカード」に少し関連したマクロです。
先日の「Wordで上書き翻訳セミナー」の受講生からお題をいただき、作ってみました。
この上書き翻訳セミナーでは、特許の段落番号にカーソルを移動させるマクロを紹介しました。
こちらの記事で紹介されているマクロをベースにしたものです。
法務翻訳の条番号でも同じようなことをしたい！とのことだったので（気持ちよく分かります（笑））、さっそく作ってみました。
もちろん、英文でも和文でもどちらでも使えるように作ってみました。
＜目次＞
このマクロでできること
マクロを実行すると、条番号を入力するためのインプットボックスが表示されます。
数字を入力すると、先頭から検索を開始して一番最初に見つかった「段落先頭に記載されている条番号」にカーソルを移動します。
ここでいう条番号とは、以下のものです。
Article 1
第1条
数字は、全角でも半角でも関係なく検索できます。また、大文字・小文字も区別しません。
マクロの解説
インプットボックスに入力した文字列が数値であるかどうかを判定するために、IsNumeric関数を使用しています。
条番号のパターンを英語表記と日本語表記とでいくつか用意しています。この文字列を検索します。
このパターンのいずれかに合致した場合にその位置にカーソルが移動します。
条番号のパターンの先頭に ^p と入れてあります。これが段落先頭の意味です。
このマクロでは、あくまでも文書中に条番号が1箇所だけに現れることを前提にしています。
複数の段落先頭に同一の条番号が記載されている場合、いずれか1つだけにカーソルが移動するということになってしまいます。
この点はご注意ください。
検索条件は、大文字小文字の区別なし、全角半角の区別なしで検索しています。
なので、Findオブジェクトでの条件設定をしていません。設定をしない場合、項目はFalse として扱われます。
可読性を高めるためには、1つ1つの設定（TrueとFalse）をきちんと書いた方がいいかもしれません。
マクロ
Sub 条番号へジャンプ() Dim myNumber As Variant '条番号の入力 Dim myFind(7) As String '条番号のパターン（英日） Dim i As Integer Dim blnFound As Boolean Dim myMessage As String 'メッセージ Dim myTitle As String 'タイトル Dim myRange As Range 'Rangeオブジェクト '------------------------------------------- '条番号の入力 '------------------------------------------- myMessage = "番号を入力して下さい。" & vbCr _ & "（半角・全角どちらでも可）" myTitle = "条番号へジャンプ" Do myNumber = InputBox(myMessage, myTitle) If myNumber = vbNullString Then End Loop While IsNumeric(myNumber) = False Or _ myNumber < 1 '------------------------------------------- '条番号のパターン（英語、日本語） '------------------------------------------- myFind(1) = "^particle " & myNumber & " " myFind(2) = "^particle " & myNumber & vbCr myFind(3) = "^particle " & myNumber & vbTab myFind(4) = "^p第" & myNumber & "条" myFind(5) = "^p第 " & myNumber & " 条" myFind(6) = "^p第 " & myNumber & "条" myFind(7) = "^p第" & myNumber & " 条" '------------------------------------------- '検索実行 '------------------------------------------- blnFound = False For i = 1 To UBound(myFind) Set myRange = ActiveDocument.Range(0, 0) With myRange.Find .Text = myFind(i) .Forward = True .Wrap = wdFindContinue .Format = False If .Execute = True Then blnFound = True Exit For End If End With Next i '------------------------------------------- '見つけた場合にジャンプ '------------------------------------------- If blnFound = True Then Selection.EndKey Unit:=wdStory myRange.Select If Selection.Characters.Last = vbCr Then Selection.MoveEnd Unit:=wdCharacter, Count:=-1 End If Selection.Collapse direction:=wdCollapseEnd Else MsgBox "条番号：" & myNumber & _ " は見つかりませんでした。", _ vbInformation, "検索結果のお知らせ" End If '------------------------------------------- 'オブジェクトの解放 '------------------------------------------- Set myRange = Nothing End Sub