Word: Delta View

Word 間の文書を比較する方法にWorkshareについている、Delta View という機能を使うという方法がある。Wordの文書比較よりも優秀な結果を示してくれるため、導入している法律事務所は多い。

http://www.workshare.com/

身も蓋も無い言い方をすると、Wordの文書比較がいけてないために存在しているようなニッチ商品であるが、文書屋にはありがたいもの。

ただ、Wordの文書比較のように変更履歴のような見かけで見せてくれるものの、これは変更履歴ではない。そのために、docで保存し、次へという履歴のツールバーのボタンを押しても、うまく作用しない。

専用のDVというソフトでは次の変更箇所というボタンがあるのだが、これでは編集がめんどくさい。

なにより、ほかのソフトの使い方を覚えないといけず、無理。

よって、Wordの機能を使いつつ、次の変更履歴箇所を順次表示していく方法は無いものかと思い、考案したのがこのマクロ。何年もたっていたのだが、依然、使えるようなので、一応掲示してみます。

構造はシンプル。

追加箇所の青、削除箇所の赤、移動箇所の緑のフォントを検索し、全部の箇所に二重線を引くという置き換えを行っているだけ。その後、検索で、二重線の場所を順次検索していけば、擬似的に、変更箇所をぽんぽんぽんと表示できるはず、というものです。マクロを実行すると、ご丁寧に、直後に検索条件まで入っているので、次の検索ってのをするだけで表示できます。

ま、多少なりともお役に立てれば、ですね。

以下、プログラム

Sub DV二重線()
'
' DV活用 Macro
' DVによる変更箇所すべてに2重下線を引く。これにより一括して検索が可能となる。

'画面更新をしない
Application.ScreenUpdating = False



Selection.HomeKey Unit:=wdStory

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Font.Color = RGB(0, 192, 0) 'みどり
.Format = True '上記フォーマットを利用する
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With

'検索でヒットした文字列に二重下線をつける
Do While Selection.Find.Execute = True
owari = Selection.End '変数の使用　""を選択としているために一番最後に、不都合が生じるため
If Selection.Start = owari Then Exit Do 'その場でとどまっている場合に、ループから抜ける

Selection.Font.Underline = wdUnderlineDouble
Selection.Collapse Direction:=wdCollapseEnd


Loop

Selection.HomeKey Unit:=wdStory

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Font.Color = vbRed '赤
.Format = True '上記フォーマットを利用する
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With

'検索でヒットした文字列に二重下線をつける
Do While Selection.Find.Execute = True
owari = Selection.End '変数の使用　""を選択としているために一番最後に、不都合が生じるため
If Selection.Start = owari Then Exit Do 'その場でとどまっている場合に、ループから抜ける

Selection.Font.Underline = wdUnderlineDouble
Selection.Collapse Direction:=wdCollapseEnd



Loop


Call DV二重線の検索

Selection.HomeKey Unit:=wdStory



End Sub


Sub DV二重線の検索()



Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Font.Underline = wdUnderlineDouble '二重下線を検索
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute


End Sub

[続きを読む]