Word录制宏后，让宏对字体的颜色更改为蓝色、无法保存

413191246se

*楼主，VBA中颜色，我个人喜欢并认为比较鲜明的是：红色（Red）/粉红（Pink）/蓝色（Blue）绿色（Green）/褐色（Brown）/橙色（Orange）/黑色（Black）自动色（Automatic）白色（White）。
*建议楼主应该首选我推荐的几种主要鲜明颜色，如果想自己更改颜色，请在代码中查找如下语句：Selection.Font.Color = wdColorRed '红色，将上面一行最后的“=wdColorRed”的后半部分“Red”（红色）更改为“Pink”（粉红），变为：Selection.Font.Color = wdColorPink '粉红；如果想将“白色”变为“绿色”，则查找如下语句：Selection.Font.Color = wdColorWhite '白色，变为：Selection.Font.Color = wdColorGreen '绿色。
*可以把各个宏拖到工具栏上为宏按钮方便使用，也可以自定义某宏为功能键如F3/F4等（自定义宏快捷键方法：工具/自定义/（下面的）键盘……/（左上角）类别：宏/（右上角）宏：点击某个宏名/指定新快捷键框中键入：F4/（下面的按钮）指定（按一下）/关闭/关闭，以后可以反复按F4键来调用某宏了！大大方便操作（将宏指定到工具栏也比较方便）。
***************************请楼主将下面的所有代码一起复制粘贴到VBE中：（按ALT+F11到VBE）
Sub 首字白色()
'1、选定文档每段首行缩进开头的第一个字。选定后让字体变为白色。
    Dim i As Paragraph
    For Each i In ActiveDocument.Paragraphs
        If i.Range.ParagraphFormat.CharacterUnitFirstLineIndent <> 0 And i.Range.ParagraphFormat.FirstLineIndent <> CentimetersToPoints(0) Then i.Range.Characters(1).Font.Color = wdColorWhite '白色
    Next
End Sub
Sub 首字紫色()
'2、选择文档每行开头的第一个字（首行缩进的除外）选定后让字体变为紫色。
    Dim i As Paragraph, j As Long, k As Long
    For Each i In ActiveDocument.Paragraphs
        If i.Range.ParagraphFormat.CharacterUnitFirstLineIndent <> 0 And i.Range.ParagraphFormat.FirstLineIndent <> CentimetersToPoints(0) Then j = 1 Else j = 0
        i.Range.Select
        Do
            Selection.HomeKey Unit:=wdLine
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If j = 1 And k = 0 Then GoTo skipfirst
            Selection.Font.Color = wdColorViolet '紫色
skipfirst:
            Selection.EndKey Unit:=wdLine
            If Asc(Selection) <> 13 Then
                Selection.MoveDown Unit:=wdLine, Count:=1
            Else
                Exit Do
            End If
            k = 1
        Loop
        k = 0
    Next
End Sub
Sub 次字黄色()
'3、选择文档每行开头的第二个字（首行缩进的除外）选定后让字体变为黄色。
    Dim i As Paragraph, j As Long, k As Long
    For Each i In ActiveDocument.Paragraphs
        If i.Range.ParagraphFormat.CharacterUnitFirstLineIndent <> 0 And i.Range.ParagraphFormat.FirstLineIndent <> CentimetersToPoints(0) Then j = 1 Else j = 0
        i.Range.Select
        Do
            Selection.HomeKey Unit:=wdLine
            Selection.MoveRight Unit:=wdCharacter, Count:=1
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If j = 1 And k = 0 Then GoTo skipfirst
            Selection.Font.Color = wdColorYellow '黄色
skipfirst:
            Selection.EndKey Unit:=wdLine
            If Asc(Selection) <> 13 Then
                Selection.MoveDown Unit:=wdLine, Count:=1
            Else
                Exit Do
            End If
            k = 1
        Loop
        k = 0
    Next
End Sub
Sub 三字黑色()
'4、选择文档每行开头的第三个字（首行缩进的除外）选定后让字体变为黑色。
    Dim i As Paragraph, j As Long, k As Long
    For Each i In ActiveDocument.Paragraphs
        If i.Range.ParagraphFormat.CharacterUnitFirstLineIndent <> 0 And i.Range.ParagraphFormat.FirstLineIndent <> CentimetersToPoints(0) Then j = 1 Else j = 0
        i.Range.Select
        Do
            Selection.HomeKey Unit:=wdLine
            Selection.MoveRight Unit:=wdCharacter, Count:=2
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If j = 1 And k = 0 Then GoTo skipfirst
            Selection.Font.Color = wdColorBlack '黑色
skipfirst:
            Selection.EndKey Unit:=wdLine
            If Asc(Selection) <> 13 Then
                Selection.MoveDown Unit:=wdLine, Count:=1
            Else
                Exit Do
            End If
            k = 1
        Loop
        k = 0
    Next
End Sub
Sub 四字红色()
'5、选择文档每行开头的第四个字（首行缩进的除外）选定后让字体变为红色。
    Dim i As Paragraph, j As Long, k As Long
    For Each i In ActiveDocument.Paragraphs
        If i.Range.ParagraphFormat.CharacterUnitFirstLineIndent <> 0 And i.Range.ParagraphFormat.FirstLineIndent <> CentimetersToPoints(0) Then j = 1 Else j = 0
        i.Range.Select
        Do
            Selection.HomeKey Unit:=wdLine
            Selection.MoveRight Unit:=wdCharacter, Count:=3
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If j = 1 And k = 0 Then GoTo skipfirst
            Selection.Font.Color = wdColorRed '红色
skipfirst:
            Selection.EndKey Unit:=wdLine
            If Asc(Selection) <> 13 Then
                Selection.MoveDown Unit:=wdLine, Count:=1
            Else
                Exit Do
            End If
            k = 1
        Loop
        k = 0
    Next
End Sub
Sub 颜色合用()
'只须把每个分过程(Sub...End Sub)的过程名拷贝到此过程即可
    首字白色
    首字紫色
    次字黄色
    三字黑色
    四字红色
End Sub

13907933959

413191246se 发表于 2015-6-20 22:05
*楼主，VBA中颜色，我个人喜欢并认为比较鲜明的是：红色（Red）/粉红（Pink）/蓝色（Blue）绿色（Green）/ ...

    前辈好！
    你真是我的贵人！真是太详细了！太好用了！你的东西总是令人非常满意、又非常高兴！又为我节省很多的时间，并且以后可以很方便的管理这些烦人的东西，颜色设置方面是由于其它地方占据了鲜明的色彩，不得以而为之，谢谢前辈！

    前辈、那个每行前面加一个符号↓，你说会改变段落结构、提醒了我，这个我没想到，能不能单在每段段未一行前面第1个字的前面加一个符号↓（首行缩进的除外，段未满行的除外）。

13907933959

13907933959 发表于 2015-6-21 07:56
前辈好！
    你真是我的贵人！真是太详细了！太好用了！你的东西总是令人非常满意、又非常高兴！又 ...

前辈好！
又碰到2个新问题：
如在同一篇的文档内2种字体一样（宋体）、字号不一样（小三、小二）但颜色相同（黄色）要更改小二的颜色为红色，要用一段怎样的代码放到里面？
文档内2种字体不一样（宋体、楷体）、字号一样（小三）颜色相同（黄色）要更改楷体为红色，要用一段怎样的代码放到里面？
还劳请前辈编写2段代码，谢谢！

413191246se

楼主，楼上问题的VBA代码，虽然是两段，但实际上是同一原理，只不过更改了相应的字体/字号/颜色。
另：上上楼的问题，楼主是一定要在每一段段末一行前面加下箭头吗？是否可以改为下划线呢？另外你说的“首行缩进的除外”，是指首行缩进的段落除外，还是指首行缩进的单独一行除外？
*******请楼主认真阅读下面两段代码注释部分（是楼上两个问题的解决代码）：
Sub 查找宋体小二黄色文字替换为红色()
'功能：如在同一篇的文档内2种字体一样（宋体）、字号不一样（小三15、小二18）但颜色相同（黄色）要更改小二的颜色为红色

''第4行代码If i.Range.Characters(n).Font.Name = "宋体" Then 中的“宋体”可以更改为“黑体”（英文双引号不要动！）
''但要注意：在XP系统和WIN7系统中，宋体/黑体字体名称都是“宋体”、“黑体”；
''在XP系统中，楷体/仿宋字体名称都叫“楷体_GB2312”“仿宋_GB2312”；在WIN7系统中，则叫“楷体”和“仿宋”。
''请楼主在 VBE 编辑界面上用鼠标右键点击工具栏，勾选“编辑”工具栏，然后在小手形状按钮后面两个按钮，就是设置注释块/解除注释块（注释行程序是不运行的）
''第二代码段落中，.Font.Underline = wdUnderlineDouble '双下线划（此语句可删除或屏蔽）这行语句可以按上面工具栏按钮注释掉
''由于字体名称这项用第二段代码找不到，所以，用全文字符遍历的方法达到目的，如果文章较大，用时会较长，运行期间不要有动作，直到出现“处理完毕”字样方可
''凡是每行第一字符是小敝(')字符的行都是注释行，都可以删除，不影响程序运行！

'查找黑体，添加单下划线
    Dim i As Paragraph, n As Long
    For Each i In ActiveDocument.Paragraphs
        For n = 1 To i.Range.Characters.Count
            If i.Range.Characters(n).Font.Name = "宋体" Then i.Range.Characters(n).Font.Underline = wdUnderlineSingle '单下划线
        Next n
    Next

'查找小二/黄色替换为红色
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Font.Size = 18 '小二
        .Font.Color = wdColorYellow '黄色（替换前）
        .Font.Underline = wdUnderlineSingle '单下划线
        With .Replacement
            .ClearFormatting
            .Font.Color = wdColorRed '红色（替换后）
            .Font.Underline = wdUnderlineDouble '双下线划（此语句可删除或屏蔽）
        End With
        .Execute FindText:="", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
    End With

'取消单下划线
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Font.Underline = wdUnderlineSingle '单下划线
        With .Replacement
            .ClearFormatting
            .Font.Underline = wdUnderlineNone '取消单下线划
        End With
        .Execute FindText:="", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
    End With
    MsgBox "处理完毕！！！！！！！！！！", vbOKOnly + vbExclamation, "查找宋体/小二/黄色文字，替换为红色"
End Sub
Sub 查找楷体小三黄色文字替换为红色()
'功能：文档内2种字体不一样（宋体、楷体）、字号一样（小三）颜色相同（黄色）要更改楷体为红色

''第4行代码If i.Range.Characters(n).Font.Name = "宋体" Then 中的“宋体”可以更改为“黑体”（英文双引号不要动！）
''但要注意：在XP系统和WIN7系统中，宋体/黑体字体名称都是“宋体”、“黑体”；
''在XP系统中，楷体/仿宋字体名称都叫“楷体_GB2312”“仿宋_GB2312”；在WIN7系统中，则叫“楷体”和“仿宋”。
''请楼主在 VBE 编辑界面上用鼠标右键点击工具栏，勾选“编辑”工具栏，然后在小手形状按钮后面两个按钮，就是设置注释块/解除注释块（注释行程序是不运行的）
''第二代码段落中，.Font.Underline = wdUnderlineDouble '双下线划（此语句可删除或屏蔽）这行语句可以按上面工具栏按钮注释掉
''由于字体名称这项用第二段代码找不到，所以，用全文字符遍历的方法达到目的，如果文章较大，用时会较长，运行期间不要有动作，直到出现“处理完毕”字样方可
''凡是每行第一字符是小敝(')字符的行都是注释行，都可以删除，不影响程序运行！
''
''重申：请自己选一段文字，录制一个宏，设为楷体，看看你的系统中楷体字的名称是“楷体”还是“楷体_GB2312”（GB意思是国标/国家标准字体）然后相应修改代码第4行中的字体
''最后结果中，红色带双下划线的文字即为目标结果，如果不想带双下划线，可以注释掉第二段代码中双下划线语句

'查找黑体，添加单下划线
    Dim i As Paragraph, n As Long
    For Each i In ActiveDocument.Paragraphs
        For n = 1 To i.Range.Characters.Count
            If i.Range.Characters(n).Font.Name = "楷体" Then i.Range.Characters(n).Font.Underline = wdUnderlineSingle '单下划线
        Next n
    Next

'查找小三/黄色替换为红色
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Font.Size = 15 '小三
        .Font.Color = wdColorYellow '黄色（替换前）
        .Font.Underline = wdUnderlineSingle '单下划线
        With .Replacement
            .ClearFormatting
            .Font.Color = wdColorRed '红色（替换后）
            .Font.Underline = wdUnderlineDouble '双下线划（此语句可删除或屏蔽）
        End With
        .Execute FindText:="", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
    End With

'取消单下划线
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Font.Underline = wdUnderlineSingle '单下划线
        With .Replacement
            .ClearFormatting
            .Font.Underline = wdUnderlineNone '取消单下线划
        End With
        .Execute FindText:="", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
    End With
    MsgBox "处理完毕！！！！！！！！！！", vbOKOnly + vbExclamation, "查找楷体小三黄色文字替换为红色"
End Sub

413191246se

楼主，关于给段落末行首字前加下箭头的代码（我现在不清楚你是否指定段落是不是首行缩进的，单行首行缩进的算不算？），推荐试试如下代码：（将每个段落的末行首字突出显示比较好，白字蓝底比较鲜明，如何？）：
Sub 末行首字突出显示_红字黄底()
'能不能单在每段段未一行前面第1个字的前面加一个符号↓（首行缩进的除外，段未满行的除外）
    Dim i As Paragraph
    For Each i In ActiveDocument.Paragraphs
        i.Range.Select
        Selection.EndKey Unit:=wdLine
        Selection.HomeKey Unit:=wdLine
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        Selection.Font.Color = wdColorRed '红色
        Selection.Font.Bold = True
        Options.DefaultHighlightColorIndex = wdYellow '黄底
        Selection.Range.HighlightColorIndex = wdYellow '黄底
        Selection.HomeKey Unit:=wdLine
    Next
End Sub
Sub 末行首字突出显示_白字蓝底()
'能不能单在每段段未一行前面第1个字的前面加一个符号↓（首行缩进的除外，段未满行的除外）
    Dim i As Paragraph
    For Each i In ActiveDocument.Paragraphs
        i.Range.Select
        Selection.EndKey Unit:=wdLine
        Selection.HomeKey Unit:=wdLine
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        Selection.Font.Color = wdColorWhite '白色
        Selection.Font.Bold = True
        Options.DefaultHighlightColorIndex = wdBlue '蓝底
        Selection.Range.HighlightColorIndex = wdBlue '蓝底
        Selection.HomeKey Unit:=wdLine
    Next
End Sub

13907933959

413191246se 发表于 2015-6-21 20:44
楼主，关于给段落末行首字前加下箭头的代码（我现在不清楚你是否指定段落是不是首行缩进的，单行首行缩进的 ...

前辈好！
由于我是一个外行再加上文字功底不深厚，问问题总不能命中要害，造成你总是要多费时间和精力，恶过、恶过，请前辈饶恕！
在所有首行缩进的段落未尾一行的首字前面加一个↓（段未满行的除外，单独一行首行缩进的除外）。不要下划线，不要首字突出显示。更改相应的字体/字号/颜色、的代码也都不要下划线。
因为这个↓在我这里是有用意的。还劳请前辈再编写一段代码，多谢、多谢！
我用的是XP系统，Word文档是2003。

13907933959

13907933959 发表于 2015-6-22 08:15
前辈好！
由于我是一个外行再加上文字功底不深厚，问问题总不能命中要害，造成你总是要多费时间和精力， ...

下面录的代码中好象没有对字体的描述？（选择楷体字时选项是“楷体_GB2312”）
Sub Macro3()
'
' Macro3 Macro
' 宏在 2015-6-22 由 User 录制
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

13907933959

13907933959 发表于 2015-6-22 08:50
下面录的代码中好象没有对字体的描述？（选择楷体字时选项是“楷体_GB2312”）
Sub Macro3()
'

前辈好！
我想把下面这几段你给我的代码组合在一起单独运成，可运成不了，弹出警示框：编辑错误、在End Sud、End Function或End属性后面只能出现注释。
下面有一句“With ActiveDocument.Content.Find”老是被蓝色盖住，还请前辈把有错误的地方修改一下，让它能运成。谢谢！
Sub 次字黄色()
'选择文档每行开头的第二个字（首行缩进的除外）选定后让字体变为黄色。
    Dim i As Paragraph, j As Long, k As Long
    For Each i In ActiveDocument.Paragraphs
        If i.Range.ParagraphFormat.CharacterUnitFirstLineIndent <> 0 And i.Range.ParagraphFormat.FirstLineIndent <> CentimetersToPoints(0) Then j = 1 Else j = 0
        i.Range.Select
        Do
            Selection.HomeKey Unit:=wdLine
            Selection.MoveRight Unit:=wdCharacter, Count:=1
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If j = 1 And k = 0 Then GoTo skipfirst
            Selection.Font.Color = wdColorYellow '黄色
skipfirst:
            Selection.EndKey Unit:=wdLine
            If Asc(Selection) <> 13 Then
                Selection.MoveDown Unit:=wdLine, Count:=1
            Else
                Exit Do
            End If
            k = 1
        Loop
        k = 0
    Next
End Sub
'查找黄色某词替换为无
   With ActiveDocument.Content.Find    （这一句老是被蓝色盖住）
        .Font.Color = wdColorYellow
        .Execute FindText:="^p", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
End With
End Sub
'查找小二/黄色替换为红色
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Font.Size = 18 '小二
        .Font.Color = wdColorYellow '黄色（替换前）
        With .Replacement
            .ClearFormatting
            .Font.Color = wdColorRed '红色（替换后）
        End With
      '查找黄色替换为黑色
    With ActiveDocument.Content.Find
        .Font.Color = wdColorYellow
        .Replacement.Font.Color = wdColorBlack
        .Execute FindText:="", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
    End With
End Sub

413191246se

一、请楼主不要说错别字，“未=未来，未尾（错）”，“末尾”才对。
二、楼主，你需要明白，在VBE中，每个以 Sub XXX()开头的一行，是一个小程序（也叫：过程）的起始标志行，每个以 End Sub 结尾的行为结束标志行。就是说，哪怕从 Sub XXX()到 End Sub里面没有一行代码，但它也是一个小过程，或叫小程序，也可以叫做一个程序模块。比如说：Sub China()...End Sub这个模块代码中，Sub China()这行只是程序开始一行，不算做代码；而 End Sub 这行，也不算做代码。所以，要想合并一些代码到一个过程（程序）中，需要复制/拷贝 Sub China()到 End Sub 之间的代码，而不要连 Sub China()这行和 End Sub 这行都复制了。——但是，现在还有更简单的方法：比如说：Sub China()这个过程，它的过程名称是 China，所以，你只须把 China 这几个字符复制到 某个过程（程序）中即可（后面的双英文括号不要复制！），而不必复制该过程的具体代码，这也叫引用 China 这个过程。你要保证一个过程（也叫程序）模块只有一个起始标志行 Sub XXX()，中间是若干代码，最后是以 End Sub 结束该模块代码，即：
Sub China()
    代码行...代码行...（注意代码行都是缩进4个字符的）----要拷贝就拷贝这些代码行！只须录制一个新宏，再把各个过程的”过程名字“，如 Sub China()中的 China 复制到新录制的宏中即可，没用的行注释掉。
End Sub
三、我和楼主是一样的系统，我也是 XP 系统，Word2003，那么楷体字的字体名称就是：楷体_GB2312（GB的意思是”国标“，=国家标准）。
四、下面附上昨天两个宏和今天这个添加下箭头的宏：（由于楼主不要颜色不要下划线，所以都去掉了，不必更改任何代码。如果文章较长，请耐心等待，直到出现“处理完毕”消息框为止。）
*****
Sub 末行首字前插入下箭头()
'功能：在所有首行缩进的段落末尾一行的首字前面加一个↓（段未满行的除外，单独一行首行缩进的除外）
    On Error Resume Next
    Dim i As Paragraph, LineCount As Integer, l As String, LineNum As Long
    For Each i In ActiveDocument.Paragraphs
        If i.Range.ParagraphFormat.CharacterUnitFirstLineIndent <> 0 And i.Range.ParagraphFormat.FirstLineIndent <> CentimetersToPoints(0) Then
            i.Range.Select
            Selection.HomeKey Unit:=wdLine
            Selection.EndKey Unit:=wdLine
            If Asc(Selection) <> 13 Then
'                i.Range.Font.Color = wdColorRed
                i.Range.Select
                '段落行数
                CommandBars("Word Count").Controls(2).Execute
                l = CommandBars("Word Count").Controls(1).List(6)
                LineCount = Int(Mid(l, 1, Len(l) - 1))
                LineNum = LineCount
                '添加↓符号
                Selection.EndKey Unit:=wdLine
                Selection.HomeKey Unit:=wdLine
                Selection.TypeText Text:="↓"
                '段落行数
                Selection.Paragraphs(1).Range.Select
                CommandBars("Word Count").Controls(2).Execute
                l = CommandBars("Word Count").Controls(1).List(6)
                LineCount = Int(Mid(l, 1, Len(l) - 1))
                If LineCount = LineNum + 1 Then Selection.Find.Execute FindText:="↓", ReplaceWith:="", Replace:=wdReplaceAll
            End If
        End If
    Next
    Selection.HomeKey Unit:=wdStory
    MsgBox "处理完毕！！！！！！！！！！！！", vbOKOnly + vbExclamation, "末行首字前插入下箭头"
End Sub
Sub 查找宋体小二黄色文字替换为红色()
'功能：如在同一篇的文档内2种字体一样（宋体）、字号不一样（小三15、小二18）但颜色相同（黄色）要更改小二的颜色为红色

'查找宋体，添加单下划线
    Dim i As Paragraph, n As Long
    For Each i In ActiveDocument.Paragraphs
        For n = 1 To i.Range.Characters.Count
            If i.Range.Characters(n).Font.Name = "宋体" Then i.Range.Characters(n).Font.Underline = wdUnderlineSingle '单下划线
        Next n
    Next

'查找小二/黄色替换为红色
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Font.Size = 18 '小二
        .Font.Color = wdColorYellow '黄色（替换前）
        .Font.Underline = wdUnderlineSingle '单下划线
        With .Replacement
            .ClearFormatting
            .Font.Color = wdColorRed '红色（替换后）
'            .Font.Underline = wdUnderlineDouble '双下线划（此语句可删除或屏蔽）
        End With
        .Execute FindText:="", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
    End With

'取消单下划线
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Font.Underline = wdUnderlineSingle '单下划线
        With .Replacement
            .ClearFormatting
            .Font.Underline = wdUnderlineNone '取消单下线划
        End With
        .Execute FindText:="", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
    End With
    MsgBox "处理完毕！！！！！！！！！！", vbOKOnly + vbExclamation, "查找宋体/小二/黄色文字，替换为红色"
End Sub
Sub 查找楷体小三黄色文字替换为红色()
'功能：文档内2种字体不一样（宋体、楷体）、字号一样（小三）颜色相同（黄色）要更改楷体为红色

'查找楷体，添加单下划线
    Dim i As Paragraph, n As Long
    For Each i In ActiveDocument.Paragraphs
        For n = 1 To i.Range.Characters.Count
            If i.Range.Characters(n).Font.Name = "楷体_GB2312" Then i.Range.Characters(n).Font.Underline = wdUnderlineSingle '单下划线
        Next n
    Next

'查找小三/黄色替换为红色
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Font.Size = 15 '小三
        .Font.Color = wdColorYellow '黄色（替换前）
        .Font.Underline = wdUnderlineSingle '单下划线
        With .Replacement
            .ClearFormatting
            .Font.Color = wdColorRed '红色（替换后）
'            .Font.Underline = wdUnderlineDouble '双下线划（此语句可删除或屏蔽）
        End With
        .Execute FindText:="", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
    End With

'取消单下划线
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Font.Underline = wdUnderlineSingle '单下划线
        With .Replacement
            .ClearFormatting
            .Font.Underline = wdUnderlineNone '取消单下线划
        End With
        .Execute FindText:="", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
    End With
    MsgBox "处理完毕！！！！！！！！！！", vbOKOnly + vbExclamation, "查找楷体小三黄色文字替换为红色"
End Sub

13907933959

413191246se 发表于 2015-6-22 12:26
一、请楼主不要说错别字，“未=未来，未尾（错）”，“末尾”才对。
二、楼主，你需要明白，在VBE中，每个 ...

前辈好！
外行就是外行，我重新录了好几个宏，也重新复制粘贴了，代码在下面，还是运成不了，我也不知错在那里，还是劳你改一下。
前辈、在“Sub 查找宋体小二黄色文字替换为红色()”和“Sub 查找楷体小三黄色文字替换为红色()”这2段代码内，是必需要有添加下划线、取消下划线、单下划线、双下线划这几个代码，还是可删除？如可删除劳请你删一下，因我不懂，尽管你作了注释，可我还是被它搞昏掉了。
前辈、还想问一下Sub 末行首字前插入下箭头()这段代码，在运行中的顺序，那个↓是不是每行都让它先加上后，其它行前的↓又再删除了，只保留了段落末行的那一个。
Sub Macro3()
'
' Macro3 Macro
' 宏在 2015-6-22 由 User 录制
'选择文档每行开头的第二个字（首行缩进的除外）选定后让字体变为黄色。
    Dim i As Paragraph, j As Long, k As Long
    For Each i In ActiveDocument.Paragraphs
        If i.Range.ParagraphFormat.CharacterUnitFirstLineIndent <> 0 And i.Range.ParagraphFormat.FirstLineIndent <> CentimetersToPoints(0) Then j = 1 Else j = 0
        i.Range.Select
        Do
            Selection.HomeKey Unit:=wdLine
            Selection.MoveRight Unit:=wdCharacter, Count:=1
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If j = 1 And k = 0 Then GoTo skipfirst
            Selection.Font.Color = wdColorYellow '黄色
skipfirst:
            Selection.EndKey Unit:=wdLine
            If Asc(Selection) <> 13 Then
                Selection.MoveDown Unit:=wdLine, Count:=1
            Else
                Exit Do
            End If
            k = 1
        Loop
        k = 0
    Next
End With
'查找黄色某词替换为无
   With ActiveDocument.Content.Find
        .Font.Color = wdColorYellow
        .Execute FindText:="^p", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
End With
'查找小二/黄色替换为红色
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Font.Size = 18 '小二
        .Font.Color = wdColorYellow '黄色（替换前）
        With .Replacement
            .ClearFormatting
            .Font.Color = wdColorRed '红色（替换后）
End With
'查找黄色替换为黑色
    With ActiveDocument.Content.Find
        .Font.Color = wdColorYellow
        .Replacement.Font.Color = wdColorBlack
        .Execute FindText:="", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
    End With
End Sub