Word: Legal Blackline Comparisons
To manually create a "legal blackline", follow these steps:
The following Word 2010 macro creates a blackline version from the existing document (the new document) and a selected document (which you will be prompted for).
Note that you should add the following registry entry to resolve a Word bug concerning large table comparison:
[HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Word\Options] "DocCompareLargeTables"=dword:00000001
Sub LegalBlackLine()
' Creates a Legal Blackline document from the current
' open document, and a selected previous version of the document.
' By Edward Chan (c) 2014
Dim fOpen As FileDialog
Dim OriginalDocument As String
Dim RevisedDocument As String
Dim ComparedDocument As Document
RevisedDocument = ActiveDocument
Set fOpen = Application.FileDialog(FileDialogType:=msoFileDialogOpen)
fOpen.AllowMultiSelect = False ' Don't allow multi-select.
fOpen.Title = "Select the old version of the file"
fOpen.InitialFileName = ActiveDocument.Path & "\Select Old File"
If fOpen.Show = -1 Then ' Selected a File
OriginalDocument = fOpen.SelectedItems.Item(1) ' Get the name of the Doc
Else
Exit Sub
End If
Documents.Open OriginalDocument, ReadOnly:=True
Set ComparedDocument = Application.CompareDocuments( _
OriginalDocument:=Documents(OriginalDocument), _
RevisedDocument:=Documents(RevisedDocument), _
Destination:=wdCompareDestinationNew, _
Granularity:=wdGranularityWordLevel, _
CompareFormatting:=False, _
CompareCaseChanges:=True, _
CompareWhitespace:=False, _
CompareTables:=True, _
CompareHeaders:=False, _
CompareFootnotes:=True, _
CompareTextboxes:=True, _
CompareFields:=False, _
CompareComments:=True, _
CompareMoves:=True, _
RevisedAuthor:="Changed to", _
IgnoreAllComparisonWarnings:=False)
Documents(OriginalDocument).Close
Documents(ComparedDocument).Activate
'Change view to redline
With Options
.InsertedTextMark = wdInsertedTextMarkColorOnly
.InsertedTextColor = wdBlue
.DeletedTextMark = wdDeletedTextMarkStrikeThrough
.DeletedTextColor = wdRed
.RevisedPropertiesMark = wdRevisedPropertiesMarkNone
.RevisedPropertiesColor = wdByAuthor
.RevisedLinesMark = wdRevisedLinesMarkNone
.CommentsColor = wdByAuthor
.RevisionsBalloonPrintOrientation = wdBalloonPrintOrientationPreserve
End With
ActiveWindow.View.RevisionsMode = wdInLineRevisions
With Options
.MoveFromTextMark = wdMoveFromTextMarkHidden
.MoveFromTextColor = wdAuto
.MoveToTextMark = wdMoveToTextMarkColorOnly
.MoveToTextColor = wdAuto
.InsertedCellColor = wdCellColorNoHighlight
.MergedCellColor = wdCellColorLightYellow
.DeletedCellColor = wdCellColorPink
.SplitCellColor = wdCellColorLightOrange
End With
With ActiveDocument
.TrackMoves = True
.TrackFormatting = True
End With
End Sub
The following Word macro saves the current document as a PDF, with blackline markings on the left hand side for tracked changes.
'
' Show the blackline view and save as PDF.
' Edward Chan 2015-10-06
'
With Options
.InsertedTextMark = wdInsertedTextMarkNone
.InsertedTextColor = wdRed
.DeletedTextMark = wdDeletedTextMarkHidden
.DeletedTextColor = wdByAuthor
.RevisedPropertiesMark = wdRevisedPropertiesMarkNone
.RevisedPropertiesColor = wdByAuthor
.RevisedLinesMark = wdRevisedLinesMarkLeftBorder
.RevisedLinesColor = wdAuto
.CommentsColor = wdByAuthor
.RevisionsBalloonPrintOrientation = wdBalloonPrintOrientationPreserve
End With
ActiveWindow.View.RevisionsMode = wdInLineRevisions
With Options
.MoveFromTextMark = wdMoveFromTextMarkHidden
.MoveFromTextColor = wdAuto
.MoveToTextMark = wdMoveToTextMarkNone
.MoveToTextColor = wdAuto
.InsertedCellColor = wdCellColorNoHighlight
.MergedCellColor = wdCellColorLightYellow
.DeletedCellColor = wdCellColorPink
.SplitCellColor = wdCellColorLightOrange
End With
With ActiveDocument
.TrackMoves = True
.TrackFormatting = False
End With
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
Replace(ActiveDocument.FullName, ".docx", ".pdf"), _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentWithMarkup, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub
Redline and PDF
In a similar fashion, here is a macro that will create redlines and blue additions:
Note that you should add the following registry entry to resolve a Word bug concerning large table comparison:
[HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Word\Options] "DocCompareLargeTables"=dword:00000001
Sub RedLineAndPDF()
'
' Show the redline view and save as PDF.
' Edward Chan 2022-06-29
'
Dim outputName As String
'Change view to redline
With Options
.InsertedTextMark = wdInsertedTextMarkColorOnly
.InsertedTextColor = wdBlue
.DeletedTextMark = wdDeletedTextMarkStrikeThrough
.DeletedTextColor = wdRed
.RevisedPropertiesMark = wdRevisedPropertiesMarkNone
.RevisedPropertiesColor = wdByAuthor
.RevisedLinesMark = wdRevisedLinesMarkNone
.CommentsColor = wdByAuthor
.RevisionsBalloonPrintOrientation = wdBalloonPrintOrientationPreserve
End With
ActiveWindow.View.RevisionsMode = wdInLineRevisions
With Options
.MoveFromTextMark = wdMoveFromTextMarkHidden
.MoveFromTextColor = wdAuto
.MoveToTextMark = wdMoveToTextMarkColorOnly
.MoveToTextColor = wdAuto
.InsertedCellColor = wdCellColorNoHighlight
.MergedCellColor = wdCellColorLightYellow
.DeletedCellColor = wdCellColorPink
.SplitCellColor = wdCellColorLightOrange
End With
With ActiveDocument
.TrackMoves = True
.TrackFormatting = True
End With
' Save doc
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
Left(ActiveDocument.FullName, InStrRev(ActiveDocument.FullName, ".")) & "pdf", _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentWithMarkup, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub