単語のワイルドカードを使用して受け入れられない変更を見つける

Question

私は、受け入れられずに追跡された変更を含むいくつかの単語文書を持っています。私はそれらを受け入れるが、私の文書に赤で表示させておきたい。私はこれを行う良い方法は、受け入れられない変更のワイルドカード検索を行い、赤で同じテキストに置き換えることだと思いますが、これが可能かどうかは分かりません。 ワイルドカードを使わずに目標を達成する他の方法にも満足しています。

Answer 1

リビジョンへの書式の適用は、Wordの標準検索である& replace操作を使用して行うことはできません。ただし、すべてのリビジョンを列挙するマクロを作成し、各リビジョンに書式を適用することができます。標準フォーマットに改訂を変換するマクロを提供クリス・レイによってブロックポストがあり

：

Enumerating edits on large documents (AKA converting tracked changes to conventional formatting)

マクロは、まだあなたが必要かを正確に行うことはできませんが、それが必要あなたを始めましょう。参考のため

は、ここでは、マクロのコピーです：

Sub EnumerateChanges() 
    Dim rAll As Revision 
    Dim dReport As Document 
    Dim dBigDoc As Document 

    Set dBigDoc = ActiveDocument 

    If dBigDoc.Revisions.Count = 0 Then 
     MsgBox "There are no revisions in the active document.", vbCritical 
    ElseIf MsgBox(“This will enumerate the changes in '" + dBigDoc.Name + "' in a new document and close the original WITHOUT saving changes. Continue?", vbYesNo) <> vbNo Then 
     Set dReport = Documents.Add 

     dBigDoc.Activate ' really just so we can show progress by selecting the revisions 
     dBigDoc.TrackRevisions = False ' Leaving this on results in a disaster 

     For Each rAll In dBigDoc.Revisions 
      ' Now find the nearest section heading downwards 
      Dim rFindFirst As Range, rFindLast As Range 
      Set rFindLast = rAll.Range.Paragraphs(1).Range 
      While Not IsNumberedPara(rFindLast.Next(wdParagraph)) 
       Set rFindLast = rFindLast.Next(wdParagraph) 
      Wend 
      ' Now head back up to the next numbered section header 
      Set rFindFirst = rFindLast 
      Do 
       Set rFindFirst = rFindFirst.Previous(wdParagraph) 
      Loop Until IsNumberedPara(rFindFirst) Or (rFindFirst.Previous(wdParagraph) Is Nothing) 
      ConvertNumberedToText rFindFirst 

      Dim rChangedSection As Range 
      Set rChangedSection = dBigDoc.Range(rFindFirst.Start, rFindLast.End) 
      ' Properly tag all the revisions in this whole section 
      Dim rOnesInThisSection As Revision 
      For Each rOnesInThisSection In rChangedSection.Revisions 
       rOnesInThisSection.Range.Select ' just for visual update 
       DoEvents ' update the screen so we can see how far we are through 
       If rOnesInThisSection.Type = wdRevisionDelete Then 
        rOnesInThisSection.Reject 
        With Selection.Range 
         .Font.ColorIndex = wdRed 
         .Font.StrikeThrough = True 
        End With 
        dBigDoc.Comments.Add Selection.Range, “deleted” 
       Else 
        If rOnesInThisSection.Type = wdRevisionInsert Then 
         rOnesInThisSection.Accept 
         With Selection.Range 
          .Font.ColorIndex = wdBlue 
         End With 
         dBigDoc.Comments.Add Selection.Range, “inserted” 
        End If 
       End If 
      Next 

      ' Now copy the whole thing into our new document 
      rChangedSection.Copy 
      Dim rOut As Range 
      Set rOut = dReport.Range 
      rOut.EndOf wdStory, False 
      rOut.Paste 
     Next rAll 

     ' There should end up being no numbered paragraphs at all in the 
     ' new doc (they were converted to text), so delete them 
     Dim pFinal As Paragraph 
     For Each pFinal In dReport.Paragraphs 
      If IsNumberedPara(pFinal.Range) Then 
       pFinal.Range.ListFormat.RemoveNumbers 
      End If 
     Next 

     dBigDoc.Close False 
    End If 
End Sub 

Sub ConvertNumberedToText(rOf As Range) 
    If InStr(rOf.ListFormat.ListString, “.”) > 0 Then 
     rOf.InsertBefore "Changes to section " + rOf.ListFormat.ListString + " " 
    End If 
End Sub 

Function IsNumberedPara(rOf As Range) As Boolean 
    If rOf Is Nothing Then ‘ if the document doesn’t have numbered sections, this will cause changes to be enumerated in the whole thing 
     IsNumberedPara = True 
    ElseIf rOf.ListFormat.ListString <> "" Then 
     If Asc(rOf.ListFormat.ListString) <> 63 Then 
      IsNumberedPara = True 
     End If 
    End If 
End Function