特許明細書に段落番号を挿入するためのマクロです。
最も初期の頃は、「段落番号挿入マクロのコード」で示したコードでしたが、これだと番号の付け直しがしにくいという問題がありました。
この問題を解決したのが、2代目です。
(1) 先に★印を入れる→(2)★印を番号に変換する、という2段階にわけています。
あとから段落番号を増やしたくなったときに、★を入れて番号付与のマクロをもう一度実行すると、新たな連番になります。
逆に減らすときは、すでにある段落番号を削って、番号付与のマクロをもう一度実行すれば、新たに連番になります。
特許出願端末が自動で段落番号を入れてくれるようになる「前に」考えたものなので、現在の特許出願実務で、このマクロが必要になることはおそらくないでしょう。
ただ、出願実務とは違う使い方で、活かせる場面は多くあると思います。
※表組みの前後など、一部、特許庁の仕様通りには入らない部分がありますが、そこは手作業で補ってください。
【★印の挿入】
|
' ★マークを追加します Dim rangeArea As Range, rangeCur As Range Dim nIndex As Long, nObjects As Long If 0 < Application.Documents.Count Then FindInitialize If Selection.Start = Selection.End Then ' 範囲選択なし Set rangeArea = ActiveDocument.Content Else ' 範囲選択あり Set rangeArea = Selection.Range End If Set rangeCur = rangeArea.Paragraphs(1).Range ' ピリオドで終わっている段落の直後に★を入れる nObjects = rangeArea.Paragraphs.Count nIndex = 1 Do While nIndex < nObjects If rangeArea.Paragraphs(nIndex).Range.Information(wdWithInTable) Then ' 表の中に入ったら一気に脱出する nIndex = nIndex + rangeArea.Paragraphs(nIndex).Range.Tables(1).Range.Paragraphs.Count Else If EndOfPeriod(rangeArea.Paragraphs(nIndex).Range.Text) Then ' 段落の最後がピリオドか？ rangeCur.SetRange Start:=rangeArea.Paragraphs(nIndex).Range.End, End:=rangeArea.Paragraphs(nIndex).Range.End InsertHoshi rangeCur nObjects = rangeArea.Paragraphs.Count nIndex = nIndex + 1 ' ★が入った分、進めておく End If nIndex = nIndex + 1 End If Loop ' 表の直後に★を入れる nObjects = rangeArea.Tables.Count For nIndex = 1 To nObjects rangeCur.SetRange Start:=rangeArea.Tables(nIndex).Range.End, End:=rangeArea.Tables(nIndex).Range.End If vbCr <> rangeCur.Words(1) Then rangeCur.InsertParagraphBefore End If InsertHoshi rangeCur Next ' 図の直後に★を入れる nObjects = rangeArea.InlineShapes.Count For nIndex = 1 To nObjects rangeCur.SetRange Start:=rangeArea.InlineShapes(nIndex).Range.End, End:=rangeArea.InlineShapes(nIndex).Range.End If vbCr <> rangeCur.Words(1) Then rangeCur.InsertParagraphBefore End If InsertHoshi rangeCur Next End If |
【番号付与】
|
With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = "★" .Replacement.Text = " 【００００】" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = False .Execute Replace:=wdReplaceAll End With Dim AddStr Dim Num Num = 1 ' カウンタの初期値を設定 Selection.HomeKey Unit:=wdStory ' カーソルを文書の先頭に移動 Selection.Find.ClearFormatting With Selection.Find .Text = " 【^#" .Forward = True .Wrap = wdFindStop ' 文書の末尾に到達したらストップ .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = False .Execute Do While .Found = True ' 検索を実行して、見つかったらループに入る Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=4 AddStr = StrConv(Format(Num, "0000"), vbWide, 1041) Selection.InsertAfter (AddStr) ' 文字列挿入 Selection.MoveRight ' 挿入した文字列の次の位置にカーソルを移動 Num = Num + 1 ' カウントアップ .Execute Loop End With |
| ※ここに示したコードは、Word 2000～2003のマクロです。2007までは動作確認ができていますが、2010以降で使用する場合は、個々に動作確認の上、必要に応じてコードの修正をしてください。 |
（→古いマクロをWord 2010/2013で使う）
【2016年の目線から】
★印の挿入は、特許庁の仕様に100%合わせることをしていません。
100%合わせることを求めると、プログラムが複雑になってしまうので、98%くらいで良いことにしました。
コンピューターとの二人三脚は常にそうだと思うのですが、１か０かで完璧を求めすぎると、うまくいきません。
たとえ98%でも95%でも、すべてを手作業でするよりは何倍も速くて確実だという考え方です。
段落番号の挿入それ自体を、翻訳者に求められるケースは減りましたが、たとえば見直しをするときの補助など、違う使い道はかなりあるので、追々そういうものもあげていきます。
■関連記事
段落番号挿入マクロのコード