I have used a Word Macro to highlight typos according to a word list (an Excel file). However, I turned on the track changes and the result did not change as a mark-up record because I used that Macro to check whether a document with 200 pages has any typos.
I tried to add the open track changes function to the Macro, but it ran very slow, or it deleted the original typo and replaced a typo then highlighted it.
Does anyone know how to just write another macro to change those highlighted texts into mark-up records? Then I can just click accept or reject. Thank you for reading this post.
Code:
Option Explicit
Sub PR()
Dim Path As String
Dim objExcel As Object
Dim iCount As Integer
Dim VChar(2000) As String
Dim maxCount As Integer
Dim RT As Boolean
Path = "D:\macro\R.xlsx"
RT = ActiveDocument.TrackRevisions
ActiveDocument.TrackRevisions = False
'Highlight variant characters
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open Path
For iCount = 2 To 2000
VChar(iCount) = objExcel.ActiveWorkbook.Sheets(1).Cells(iCount, 1)
If objExcel.ActiveWorkbook.Sheets(1).Cells(iCount, 3) = "T" Then _
Selection.Find.MatchWildcards = True
If Len(VChar(iCount)) = 0 Then Exit For
Next iCount
maxCount = iCount - 1
' maxCount is the total number of entries
objExcel.ActiveWorkbook.Close
objExcel.Quit
Options.DefaultHighlightColorIndex = wdTurquoise
Selection.HomeKey Unit:=wdStory
' It is not necessary to move the cursor as there is only replacement.
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = True
.Replacement.Text = "^&"
.Wrap = wdFindStop ' Up to end of document
' Keep settings outside the loop to save steps
For iCount = 2 To maxCount
.Text = VChar(iCount)
.Execute Replace:=wdReplaceAll
Next
End With
ActiveDocument.TrackRevisions = RT
End Sub