【コード】変更履歴の追記箇所に下線を引く(その3)

以前ご紹介いたしました「変更履歴の追記箇所に下線を引く」と「変更履歴の追記箇所に下線を引く(その2)」とがございました。

その2のマクロは、日本特許庁への提出書類(出願明細書)の補正時に、補正箇所をマーキングするものでした。

週末のとあるセミナーでお会いしたからからのご要望を受けて、マーキング方法を変更しました。外国の特許庁(例えば、米国の特許商標庁など)に提出する書類の補正で使います。

このマクロでできること

変更履歴に基づいて、以下のようにマーキングをします。

・挿入した文字列には下線を引きます。

・削除した文字列には取消線を引きます。

上記2点以外の変更履歴については、マーキングをしません。

以下のように変更履歴がある場合の例を示します。

変更履歴に記録されているのは、以下の点です。

「こ」と「電気」が削除されて「あ」が追記されています。

また、「です」の文字の色が変更されました。

(マクロ実行前)

16-06-046

(マクロ実行後)

16-06-047

なお、マクロ実行時に「変更履歴の記録」がオフになります。

また、文書内のすべての変更が承認されます。

マクロの解説

For Each … Next ステートメントを用います。

考え方は、前回の「変更履歴の追記箇所に下線を引く(その2)」と同じです。

以下の3点を変更しました。

  • 冒頭に、「更新履歴の記録」をオフにする設定を追加しました。(6行目)
  • 削除された文字列に対して、取消線を追加します。(22行目)
  • また、削除された文字列を表示させるために、「変更を元に戻す」を実行しています。(23行目)

マクロ


Sub 変更履歴_追記箇所に下線をひくマクロ_3()

 Dim myRev As Revision

 '変更履歴の記録をオフにする
 ActiveDocument.TrackRevisions = False
 
 For Each myRev In ActiveDocument.Revisions
 
  Select Case myRev.Type
 
   '挿入の場合
   Case wdRevisionInsert
    With myRev.Range
     .Font.Underline = wdUnderlineSingle
     .Revisions.AcceptAll
    End With
 
   '削除の場合
   Case wdRevisionDelete
    With myRev.Range
     .Font.StrikeThrough = True
     .Revisions.RejectAll
    End With
  
   'それ以外の場合
   Case Else
    With myRev.Range
     .Revisions.AcceptAll
    End With
  
  End Select
 
 Next

 Set myRev = Nothing

End Sub

トップへ戻る