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

13907933959

413191246se 发表于 2015-6-29 11:10
楼主，虽然你把我捧上了天，但我知道我水平高低，昨晚并未出结果，今天刚才终于成功！（我其实是VBA小菜鸟 ...

师傅好！
我不是捧你，在我心里对你的评价确实如此，由于电脑方面的知识太深，我这个外行提的问题又没有什么套路，难为师傅你了，再加上老是因我不能准确的描述想要的效果，造成对你时间不必要的浪费，抱歉、抱歉！
今天的2个代码我试用了几遍，文字前面搜入的《 ，能准确插入，文字后面搜入的 》，不知为什么老是插在了下一行的开头。

413191246se

楼主，你把你试用的例文打包上传上来，我看看有没有问题，我用的示例文件百试百灵。

413191246se

楼主，你看看我的示例文件，百试百灵。如果不灵，把你的示例文件打包上传上来，我看看。
我的示例文档： demo 常规练习.rar (3.63 KB, 下载次数: 16)

2015-6-29 16:17 上传

点击文件名下载附件

413191246se

楼主，你的问题中，“字句”到底是什么意思？我从来没听说过这个词。在 Word 中，应该说，文字（包括一个或几个）、词、段落。
另外，我看你的问题中，第4-6都是查找文中红色字词前后插入书名号，但我觉得和1-3是一样的。正文是不是都是有标点符号结尾的？你的标题是不是没有标点符号？我先编7-9问题宏吧！（你先想想1-3/4-6到底想问什么问题？要不提供一下示例文字。）

13907933959

413191246se 发表于 2015-6-29 15:57
楼主，你把你试用的例文打包上传上来，我看看有没有问题，我用的示例文件百试百灵。

列文

13907933959

413191246se 发表于 2015-6-29 16:36
楼主，你的问题中，“字句”到底是什么意思？我从来没听说过这个词。在 Word 中，应该说，文字（包括一个或 ...

师傅好！
不好意思！字句2字怪我没有说清楚，我的意思是包括单独一个字的，一行字，一段字的，一个段落的。
在颜色、字体、字号段前、段后插入符号《××××××××》。
1、在文档内单独一行的红色字前面插入《       字后面指入 》
意思是只在单独一行的红色字前面插入前引号，字后面指入后引号，因文档内还有其它颜色的字。
2、在文档内单独一行的宋体字前面插入《       字后面指入 》
意思是只在单独一行的宋体字前面插入前引号，后面指入后引号，因文档内还有其它字体的字。
3、在文档内单独一行的小二字前面插入《       字后面指入 》
意思是只在单独一行的小二字前面插入前引号，后面指入后引号，因文档内还有其它字号的字。
4、在文档内红色字（正文行中含有红色文字）的前面插入《       文字后面指入 》
意思是只在红色字前面插入前引号，后面指入后引号，因红色字前后还有其它颜色的字。
5、在文档内宋体字（正文行中含有宋体字）的前面插入《       字后面指入 》
意思是只在宋体字前面插入前引号，后面指入后引号，因宋体字前后还有其它字体的字。
6、在文档内小二字（正文行中含有小二字）的前面插入《       字后面指入 》
意思是只在小二字号前面插入前引号，后面指入后引号，因小二字前后还有其它字号的字。
7、句子开头和结尾带有符号的如：［］ 、＼X  改变颜色，如：黑色改为紫色
8、句子开头和结尾带有符号的（如：［］ 、＼X）改变字体，如：宋体改为楷体
9、句子开头和结尾带有符号的（如：［］ 、＼X）改变字号，如：小二改为小五

413191246se

楼主：
1、“例文”=示例文档，不是“列文”（列举文档），少说错别字。
2、单行红色宏确实有问题，原因就在于你的示例文档有空格/空行，我的没有，所以，代码就不够严密，问题已经得到解决。
3、以后在执行VBA宏的过程中，如果显示“程序未响应”（或“程序正在运行”），就是不听指挥了，此时（以及任何时候），只须按 Ctrl + PauseBreak 组合键即可结束 VBA 进程！弹出的对话框中选择“结束”即可。（PauseBreak 键也叫暂停键，就在 ScreenScroll 键旁边，F12键右边的三个键中的一个。）
4、其实宏出现问题也很好，我又更新了代码，加了两句就OK了！现在更完善了。
5、九个问题，现在一个一个解决吧，不要着急。我现在先提供一下第一个问题的解决代码：
*************
Sub 单行红色_前后插入书名号()
    Dim i As Paragraph, n As Long
    For Each i In ActiveDocument.Paragraphs
        i.Range.Select
        Selection.HomeKey Unit:=wdLine
        Selection.EndKey Unit:=wdLine
        If Asc(Selection) = 13 Then
            i.Range.Select
            '选定段落查找红色字符_前后添加书名号
            Selection.HomeKey Unit:=wdLine
            Do
                Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                If Selection.Characters.Last.Text = vbCr Then Exit Do
                If Selection.Characters.Last.Font.Color = wdColorRed Then
                    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                    If Selection.Characters.Last.Font.Color = wdColorRed Then
                        Do
                            If Selection.Characters.Last.Text = vbCr Then Exit Do
                            If Selection.Characters.Last.Font.Color = wdColorRed Then
                                Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                            Else
                                Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                                Exit Do
                            End If
                        Loop
                    Else
                        Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                    End If
                    Selection.InsertBefore Text:="《"
                    Selection.Font.Color = wdColorRed
                    If Selection.Characters.Last.Text = vbCr Then Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                    Selection.InsertAfter Text:="》"
                    Selection.MoveRight Unit:=wdCharacter, Count:=1
                Else
                    Selection.MoveRight Unit:=wdCharacter, Count:=1
                End If
            Loop
        End If
    Next
End Sub

413191246se

楼主，《单行宋体/单行小二》两个宏，我并未重编，只是把《单行红色》宏中的 Color = wdColorRed 全部替换为 Name = "宋体"/Size =18 即完成，测试OK，你试试吧！（因为我重新编辑了两个工具宏：《判断单行》和《选定段落查找红色_前后插入书名号》。
**********************（请将这两个宏代码一起拷贝到VBE中）
Sub 单行宋体_前后插入书名号()
    Dim i As Paragraph, n As Long
    For Each i In ActiveDocument.Paragraphs
        i.Range.Select
        Selection.HomeKey Unit:=wdLine
        Selection.EndKey Unit:=wdLine
        If Asc(Selection) = 13 Then
            i.Range.Select
            '选定段落查找宋体字符_前后添加书名号
            Selection.HomeKey Unit:=wdLine
            Do
                Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                If Selection.Characters.Last.Text = vbCr Then Exit Do
                If Selection.Characters.Last.Font.Name = "宋体" Then
                    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                    If Selection.Characters.Last.Font.Name = "宋体" Then
                        Do
                            If Selection.Characters.Last.Text = vbCr Then Exit Do
                            If Selection.Characters.Last.Font.Name = "宋体" Then
                                Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                            Else
                                Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                                Exit Do
                            End If
                        Loop
                    Else
                        Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                    End If
                    Selection.InsertBefore Text:="《"
                    Selection.Font.Name = "宋体"
                    If Selection.Characters.Last.Text = vbCr Then Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                    Selection.InsertAfter Text:="》"
                    Selection.MoveRight Unit:=wdCharacter, Count:=1
                Else
                    Selection.MoveRight Unit:=wdCharacter, Count:=1
                End If
            Loop
        End If
    Next
End Sub
Sub 单行小二_前后插入书名号()
    Dim i As Paragraph, n As Long
    For Each i In ActiveDocument.Paragraphs
        i.Range.Select
        Selection.HomeKey Unit:=wdLine
        Selection.EndKey Unit:=wdLine
        If Asc(Selection) = 13 Then
            i.Range.Select
            '选定段落查找小二字符_前后添加书名号
            Selection.HomeKey Unit:=wdLine
            Do
                Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                If Selection.Characters.Last.Text = vbCr Then Exit Do
                If Selection.Characters.Last.Font.Size = 18 Then
                    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                    If Selection.Characters.Last.Font.Size = 18 Then
                        Do
                            If Selection.Characters.Last.Text = vbCr Then Exit Do
                            If Selection.Characters.Last.Font.Size = 18 Then
                                Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                            Else
                                Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                                Exit Do
                            End If
                        Loop
                    Else
                        Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                    End If
                    Selection.InsertBefore Text:="《"
                    Selection.Font.Size = 18
                    If Selection.Characters.Last.Text = vbCr Then Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                    Selection.InsertAfter Text:="》"
                    Selection.MoveRight Unit:=wdCharacter, Count:=1
                Else
                    Selection.MoveRight Unit:=wdCharacter, Count:=1
                End If
            Loop
        End If
    Next
End Sub

13907933959

413191246se 发表于 2015-6-29 22:26
楼主，《单行宋体/单行小二》两个宏，我并未重编，只是把《单行红色》宏中的 Color = wdColorRed 全部替换 ...

师傅好！

刚才用了3个宏，相当的好用，我说你的实力是蓝波湾你总是谦虚，每次都是因我的原因影响到你的实力发挥，并不是你的实力不够，这点我很清楚。

师傅、徒弟因以前读书没有用功，错别字这个毛病总是很难注意到，这个我的中医师傅也多次说过我，以后会尽量注意，只是一不小心又会出现，还请你多见谅！

经过这段时间和你接触，我知道师傅你不但是一个肯热情帮助别人的人，还是一个办事仔细认真，高度负责任且雷厉风行的人，正是因为你有以上的优点，所以在电脑技艺上才能达到如此高度，真是让人佩服！

师傅、等你有时间可否再帮我在这3个宏和剩下的宏内分别再加一个颜色、字体、字号的控制代码，比方说：现在在同一篇文档中，我用“单行宋体字”前后加引号的宏，想给单行黑色、宋体、小三字前后加上了引号，会连同该文档中的单行其它颜色的宋体字及其它字号的宋体字前后都加上了引号，如果能在颜色、字体、字号上设置三项控置代码，就可准确无误的加上引号，这个控置颜色、字体、字号的代码不用时也可拿掉。

谢谢师傅！

413191246se

楼主，下面是《全文红色/宋体/小二_前后插入书名号》三个宏：（楼主问题WAIT）
*****************************
Sub 全文红色_前后插入书名号()
    Dim i As Paragraph, n As Long
    For Each i In ActiveDocument.Paragraphs
        i.Range.Select
        '选定段落查找红色字符_前后添加书名号
        Selection.HomeKey Unit:=wdLine
        Do
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If Selection.Characters.Last.Text = vbCr Then Exit Do
            If Selection.Characters.Last.Font.Color = wdColorRed Then
                Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                If Selection.Characters.Last.Font.Color = wdColorRed Then
                    Do
                        If Selection.Characters.Last.Text = vbCr Then Exit Do
                        If Selection.Characters.Last.Font.Color = wdColorRed Then
                            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                        Else
                            Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                            Exit Do
                        End If
                    Loop
                Else
                    Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                End If
                Selection.InsertBefore Text:="《"
                Selection.Font.Color = wdColorRed
                If Selection.Characters.Last.Text = vbCr Then Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                Selection.InsertAfter Text:="》"
                Selection.MoveRight Unit:=wdCharacter, Count:=1
            Else
                Selection.MoveRight Unit:=wdCharacter, Count:=1
            End If
        Loop
    Next
End Sub
Sub 全文宋体_前后插入书名号()
    Dim i As Paragraph, n As Long
    For Each i In ActiveDocument.Paragraphs
        i.Range.Select
        '选定段落查找宋体字符_前后添加书名号
        Selection.HomeKey Unit:=wdLine
        Do
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If Selection.Characters.Last.Text = vbCr Then Exit Do
            If Selection.Characters.Last.Font.Name = "宋体" Then
                Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                If Selection.Characters.Last.Font.Name = "宋体" Then
                    Do
                        If Selection.Characters.Last.Text = vbCr Then Exit Do
                        If Selection.Characters.Last.Font.Name = "宋体" Then
                            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                        Else
                            Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                            Exit Do
                        End If
                    Loop
                Else
                    Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                End If
                Selection.InsertBefore Text:="《"
                Selection.Font.Name = "宋体"
                If Selection.Characters.Last.Text = vbCr Then Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                Selection.InsertAfter Text:="》"
                Selection.MoveRight Unit:=wdCharacter, Count:=1
            Else
                Selection.MoveRight Unit:=wdCharacter, Count:=1
            End If
        Loop
    Next
End Sub
Sub 全文小二_前后插入书名号()
    Dim i As Paragraph, n As Long
    For Each i In ActiveDocument.Paragraphs
        i.Range.Select
        '选定段落查找小二字符_前后添加书名号
        Selection.HomeKey Unit:=wdLine
        Do
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If Selection.Characters.Last.Text = vbCr Then Exit Do
            If Selection.Characters.Last.Font.Size = 18 Then
                Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                If Selection.Characters.Last.Font.Size = 18 Then
                    Do
                        If Selection.Characters.Last.Text = vbCr Then Exit Do
                        If Selection.Characters.Last.Font.Size = 18 Then
                            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                        Else
                            Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                            Exit Do
                        End If
                    Loop
                Else
                    Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                End If
                Selection.InsertBefore Text:="《"
                Selection.Font.Size = 18
                If Selection.Characters.Last.Text = vbCr Then Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                Selection.InsertAfter Text:="》"
                Selection.MoveRight Unit:=wdCharacter, Count:=1
            Else
                Selection.MoveRight Unit:=wdCharacter, Count:=1
            End If
        Loop
    Next
End Sub