Выделение всех исправлений в тексте

[Coolira]

Добрый день! Подскажите, как можно быстро выделить и скопировать все исправления в тексте? Вообще задача такая: Есть большой файл (ок. 3 тыс страниц), в этом файле куча исправлений (где-то штук 700). В идеале от файла должны остаться только исправления (вставки и удаления) и несколько строк до/после исправления. Я каждый месяц вручную проделываю эту работу, сил уже нет. Если у кого-то есть мысли - подтолкните меня к решению, пожалуйста )) а мб есть какой-то элементарный способ, а сижу и туплю (
Ну хотя бы выделить все исправления как?

[shanemac51]

попробуйте макрос на копии документа

Sub w41107_1213()
'
Dim rev As Revision, j1, S0, S1, S2, SS
Dim pr As Paragraph
    ''ActiveWindow.View.MarkupMode = wdInLineRevisions
    ''ActiveWindow.ToggleShowAllReviewers
    Debug.Print Word.ActiveDocument.Revisions.Count
    SS = ""
    For Each pr In Word.ActiveDocument.Paragraphs
    j1 = 0
    S1 = pr.Range.Text
    If pr.OutlineLevel <> wdOutlineLevelBodyText Then
    S0 = pr.Range.Text
    End If
    
    
    If pr.Range.Revisions.Count > 0 Then
     If Len(S0) > 0 Then
    SS = SS & "### " & Chr(13) & Chr(10)
    SS = SS & "### " & S0
    SS = SS & "### " & Chr(13) & Chr(10)
    S0 = ""
    End If
    S2 = "----------ИЗМЕНЕННАЯ СТРОКА--------" & Chr(13) & Chr(10)
    SS = SS & S2
    SS = SS & S1
 
    
    
    For Each rev In pr.Range.Revisions
    j1 = j1 + 1
    
    
    
    Debug.Print j1; "/"; rev.Type; " DT="; rev.Date; " AVT="; rev.Author; " TEXT="; rev.Range.Text
    'Debug.Print rev.Style
      SS = SS & j1 & "/" & rev.Type & " DT=" & rev.Date
      SS = SS & " AVT=" & rev.Author
      SS = SS & " TEXT=" & rev.Range.Text & Chr(13) & Chr(10)
  
    'Debug.Print rev.Style
    Next rev
    End If
NEXT_PR:
    Next pr
    Word.Documents.Add
    Selection.Range.Text = SS
End Sub