Я не знаю, как можно сравнивать более двух документов одновременно на экране.
Если у вас есть несколько ревизионных документов, вы можете объединить их в один новый документ, но вы, вероятно, уже знаете об этой функции.
Если у вас есть несколько документов ревизий, и вы хотите немного "автоматизировать" процесс, чтобы сократить некоторые из вводимых вручную действий, вы можете использовать макрос, подобный приведенному ниже.
Sub CompareDocs()
Dim doc As word.Document, iDoc As word.Document, rDoc As word.Document
Dim selFiles() As String, strFolderPath As String
Dim Sep As String, i As Long
On Error GoTo errHandler
Sep = Application.PathSeparator
Set doc = ActiveDocument
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select the files to compare to your source document"
.InitialFileName = curDir
.AllowMultiSelect = True
If .Show = 0 Then
Exit Sub
End If
ReDim Preserve selFiles(.SelectedItems.Count - 1)
strFolderPath = Left(.SelectedItems(1), InStrRev(.SelectedItems(1), Sep))
For i = 0 To .SelectedItems.Count - 1
selFiles(i) = .SelectedItems(i + 1)
Next
End With
For i = 0 To UBound(selFiles)
Set iDoc = Documents.Open(selFiles(i))
Set rDoc = Application.CompareDocuments(OriginalDocument:=doc, RevisedDocument:=iDoc, _
CompareFormatting:=False, CompareComments:=False)
rDoc.SaveAs2 strFolderPath & "Compared_" & iDoc.Name
rDoc.Close
iDoc.Close
Next
Application.ScreenUpdating = True
MsgBox "Document Compares Complete"
Exit Sub
errHandler:
MsgBox Err.Description, vbCritical, "Compare Docs"
Err.Clear
Application.ScreenUpdating = True
End Sub