word一键接受所有修订并保留修订痕迹

目的：让word修订插入的内容在接受修订后保留痕迹。

文章目录

• • 目的：让word修订插入的内容在接受修订后保留痕迹。
  • • [1. 打开批注的word文件](#1. 打开批注的word文件)
    • [2. 同时按住：*Alt+F11*，然后右键：Normal -->插入--> 模块](#2. 同时按住：Alt+F11，然后右键：Normal -->插入--> 模块)
    • [3. 在出现的代码框中插入以下代码（如下图）](#3. 在出现的代码框中插入以下代码（如下图）)
    • [4. 鼠标放到代码的任意一行，按：*F5* 运行代码](#4. 鼠标放到代码的任意一行，按：F5 运行代码)
    • [5. 先别关闭这个界面，直接查看word文档里，修订的内容是不是变成蓝色了](#5. 先别关闭这个界面，直接查看word文档里，修订的内容是不是变成蓝色了)
    • [6. 这个时候在word文档里，接受所有修订即可](#6. 这个时候在word文档里，接受所有修订即可)
    • [7. 查看此时的word文档是否符合您的要求](#7. 查看此时的word文档是否符合您的要求)
    • [8. 保存，退出。](#8. 保存，退出。)

1. 打开批注的word文件

2. 同时按住：Alt+F11，然后右键：Normal -->插入--> 模块

3. 在出现的代码框中插入以下代码（如下图）

Sub 保留修订痕迹()
'
' 保留修订痕迹 宏
'
'
    Dim rngTemp As Range
    Dim revTemp As Revision
    
    Do While True
        Set revTemp = Selection.NextRevision(Wrap:=False)
        If Not (revTemp Is Nothing) Then
         If revTemp.Type = wdRevisionInsert Then  '如果是新增，则该内容颜色变为蓝色
            revTemp.Range.Font.ColorIndex = wdBlue
            Selection.Font.Underline = wdUnderlineSingle
            revTemp.Accept
         End If
        Else
            MsgBox Prompt:="已无修订"
        Exit Do
        End If
    Loop
    
End Sub

4. 鼠标放到代码的任意一行，按：F5 运行代码

5. 先别关闭这个界面，直接查看word文档里，修订的内容是不是变成蓝色了

如果插入的内容没有全部变蓝，把word文档划到第一页，再次执行步骤4 即可

6. 这个时候在word文档里，接受所有修订即可

7. 查看此时的word文档是否符合您的要求

8. 保存，退出。