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

以前の記事「【コード】変更履歴の追記箇所に下線を引く(その3) 」のプチ修正版です。

前回の記事では、変更履歴の削除箇所を「取り消し線」、挿入箇所を「下線」という「文字書式」に変換する処理を紹介しました。

今回の記事では、上記に加えて、削除箇所、挿入箇所ともに「赤文字」にするという処理を加えました。

実は最近、Macを使っている方の文章を修正する仕事がありまして、そのときにWordの変更履歴を使ってみました。

ただ、本人に修正箇所を伝えるにあたって、変更履歴付きのWordファイルを渡すのはちょっと違うかな?と思ったわけです。受け手側で変更履歴の表示がどうなるのかわからないし。

そこで、このようにマクロを修正しました。変更箇所をわかりやすくするために赤文字にしてみました。

このマクロでできること

変更履歴の削除箇所を、削除した文字列を表示させて、その文字に「取り消し線」と「赤文字」の書式を設定します。

変更履歴の挿入箇所を、挿入箇所を確定し、「下線」の文字書式を設定します。

(実行前)

以下のように、[すべての変更履歴を本文中に表示]をオンにしています。

変更履歴

すると、以下のように挿入箇所と削除箇所が表示されます。「Word」の文字を削除して「ワード」に書き換えました。

デフォルトの設定で、挿入箇所と削除箇所が紫色で表示されています。

変更履歴

(実行後)

変更履歴はなくなり、文字書式で表示されています。

変更履歴

マクロの解説

17行目と25行目にフォントの色を赤にする処理を追加しました。

それ以外は、前回の記事「【コード】変更履歴の追記箇所に下線を引く(その3) 」のマクロと同じです。

変更履歴のオブジェクトのRangeプロパティFont.ColorIndex プロパティを設定して文字の色を設定しています。

マクロ


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

 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
     .Font.ColorIndex = wdRed
    End With

   '削除の場合
   Case wdRevisionDelete
    With myRev.Range
     .Font.StrikeThrough = True
     .Revisions.RejectAll
     .Font.ColorIndex = wdRed
    End With
 
   'それ以外の場合
   Case Else
    With myRev.Range
     .Revisions.AcceptAll
    End With
 
  End Select

 Next

 Set myRev = Nothing

End Sub

トップへ戻る