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

413191246se

413191246se

看来，还是要说话的。图片未必能解决全部事情。-----请将图片下载，反复观摩学习。
楼主，处理完 FindSymbol 这个宏以后，要全选重新粘贴回 VBE 中，然后，执行《单行查找》和《全文查找》两个宏就行了。
代码中，不算 Sub FindSymbol()这一行，第 5 行代码，你看清楚，反复读一读（都是英语，浅显的）：
If (Selection.Characters.Last.Font.Color = wdColorRed And Selection.Characters.Last.Font.Name = "宋体") And Selection.Characters.Last.Font.Size = 18 Then
这句代码的意思是：如果字体颜色是红色（.Font.Color = wdColorRed），并且字体名称是宋体（.Font.Name = "宋体"），并且字体大小是18磅（小二）的话，则……

413191246se

夸奖楼主一句：我看了你昨天的 find_x 代码中，一些 ActiveDocument.Content.Find 全部替换的例子，做得不错！

13907933959

413191246se 发表于 2015-7-1 22:19

师傅好！
这2张图片请用全文字格式重发一次给我、谢谢！

13907933959

413191246se 发表于 2015-7-1 22:31
夸奖楼主一句：我看了你昨天的 find_x 代码中，一些 ActiveDocument.Content.Find 全部替换的例子，做得不 ...

师傅好！
第一次得到师傅夸奖，心里那个美、那个美、那个激动……，不过徒弟还是受之有愧，那个 find_x 代码中，加 ActiveDocument.Content.Find 替换的步骤，我不是就真有这个水平，而是估计带统计乱蒙的，心里想反正有师傅在，错了有你答救，不然万万不敢，在刚运行它时心里咚咚、咚咚直响。
师傅，你不但帮我解决遇到的难题，还一直不厌不弃的用时间和知识，培养着这个又笨又傻的徒弟，是你把一个什么都不懂的我领进了VBA的这个门，在这里说声谢谢师傅，你辛苦了、受累了、徒弟从心里感激你！！！
师傅、我从小在偏远的山村里（到县城要座6个多小时的车，中途还要转2次车）出生、长大、读书，学校里就一个老师，11个学生，我没有学过一句英文和拼音，没有注释成中文的我根本就看不懂，到我16岁时村里才通了电，我学医一是家里非常穷，二也是没有学英文的原因根本考不了大学，才念完所谓的初中不得不选择去学中医，这也是我心理永远的痛！

13907933959

413191246se 发表于 2015-7-1 22:30
看来，还是要说话的。图片未必能解决全部事情。-----请将图片下载，反复观摩学习。
楼主，处理完 FindSymb ...

师傅好！
这个 Sub FindSymbol() 宏，好象一次只能插入（光标放在那里的）一对符号，不能把所有符合条件的都插入符号。
另外麻烦师傅可不可把这个改为可执行的宏？

13907933959

413191246se 发表于 2015-6-30 16:51
楼主，因你未说清符号在段落首尾，是要设置整个段落还是设置该符号的颜色/字体/字号，所以，我选前者。
** ...

师傅、这个 Sub 首尾符号() 的宏，我把查找符号的这一行换为＼X后，它会出一个确认的提示框，确认后运行不了。肯定是这一行换符号的我没有换好，请师傅指点。再请师傅看一下这3句中文注释是不是对应在这3个代码上。如只将其中一句作为控制标准另行2句可否任意拿掉？

Sub 首这尾符号()
    Dim i As Paragraph, j As String
    j = InputBox("＼X", "段落首尾有符号_黑色改为紫色", "＼X")
    If j = "" Then Exit Sub
    For Each i In ActiveDocument.Paragraphs
'句子开头和结尾带有符号的如：［］ 、＼X  改变颜色，如：黑色改为粉色
        If i.Range.Characters(1).Text = j Or i.Range.Characters.Last.Previous.Text = j Then i.Range.Font.Color = wdColorPink '粉红
'句子开头和结尾带有符号的改变字体，如：宋体改为楷体
        If i.Range.Characters(1).Text = j Or i.Range.Characters.Last.Previous.Text = j Then i.Range.Font.Name = "楷体_GB2312"
'句子开头和结尾带有符号的改变字号，如：小二改为小五
If i.Range.Characters(1).Text = j Or i.Range.Characters.Last.Previous.Text = j Then i.Range.Font.Size = 9 '小五
    Next
End Sub

413191246se

*****************
Sub 全文查找_红色宋体小二_前后添加书名号_通用()
    Dim i As Paragraph, e As Long, x As String, y As String, z As String, strColor As String, strFont As String, strSize As String
    If MsgBox("是否全文查找？（选否单行查找）", vbYesNo + vbExclamation, "查找颜色/字体/字号_前后添加书名号") = vbYes Then e = 2 Else e = 1

'颜色
InputColor:
    x = InputBox("自动/红色/粉红/绿色/蓝色/黄色/橙色/褐色/青色/黑色/白色/茶色/金色/鲜绿/淡紫/靛蓝/天蓝/浅蓝/深黄/海绿/深绿/深红/梅红/深青/青绿/深蓝/淡蓝/酸橙色/浅橙色/橄榄色/水绿色/玫瑰红/紫罗兰/", "请输入颜色名称！", "红色")
    If x = "" Then GoTo InputColor

    If x = "自动" Then
        strColor = wdColorAutomatic
    ElseIf x = "红色" Then
        strColor = wdColorRed
    ElseIf x = "粉红" Then
        strColor = wdColorPink
    ElseIf x = "绿色" Then
        strColor = wdColorGreen
    ElseIf x = "蓝色" Then
        strColor = wdColorBlue
    ElseIf x = "黄色" Then
        strColor = wdColorYellow
    ElseIf x = "橙色" Then
        strColor = wdColorOrange
    ElseIf x = "褐色" Then
        strColor = wdColorBrown
    ElseIf x = "青色" Then
        strColor = wdColorTeal
    ElseIf x = "黑色" Then
        strColor = wdColorBlack
    ElseIf x = "白色" Then
        strColor = wdColorWhite
    ElseIf x = "茶色" Then
        strColor = wdColorTan
    ElseIf x = "金色" Then
        strColor = wdColorGold
    ElseIf x = "鲜绿" Then
        strColor = wdColorBrightGreen
    ElseIf x = "淡紫" Then
        strColor = wdColorLavender
    ElseIf x = "靛蓝" Then
        strColor = wdColorIndigo
    ElseIf x = "天蓝" Then
        strColor = wdColorSkyBlue
    ElseIf x = "浅蓝" Then
        strColor = wdColorLightBlue
    ElseIf x = "深黄" Then
        strColor = wdColorDarkYellow
    ElseIf x = "海绿" Then
        strColor = wdColorSeaGreen
    ElseIf x = "深绿" Then
        strColor = wdColorDarkGreen
    ElseIf x = "深红" Then
        strColor = wdColorDarkRed
    ElseIf x = "梅红" Then
        strColor = wdColorPlum
    ElseIf x = "深青" Then
        strColor = wdColorDarkTeal
    ElseIf x = "青绿" Then
        strColor = wdColorTurquoise
     ElseIf x = "深蓝" Then
        strColor = wdColorDarkBlue
    ElseIf x = "淡蓝" Then
        strColor = wdColorPaleBlue
    ElseIf x = "酸橙色" Then
        strColor = wdColorLime
    ElseIf x = "浅橙色" Then
        strColor = wdColorLightOrange
    ElseIf x = "橄榄色" Then
        strColor = wdColorOliveGreen
    ElseIf x = "水绿色" Then
        strColor = wdColorAqua
    ElseIf x = "玫瑰红" Then
        strColor = wdColorRose
    ElseIf x = "紫罗兰" Then
        strColor = wdColorViolet
    Else
        GoTo InputColor
    End If

'字体
InputFont:
    y = InputBox("宋/仿/楷/黑（或：宋体/仿宋/楷体/黑体）", "请输入字体名称！ ", "宋体")
    If y = "" Then GoTo InputFont

    If y = "宋" Or y = "宋体" Then
        strFont = "宋体"
    ElseIf y = "仿" Or y = "仿宋" Then
        strFont = "仿宋_GB2312"
    ElseIf y = "楷" Or y = "楷体" Then
        strFont = "楷体_GB2312"
    ElseIf y = "黑" Or y = "黑体" Then
        strFont = "黑体"
    Else
        GoTo InputFont
    End If

'字号
InputSize:
    z = InputBox("一号26/小一24/二号22/小二18/三号16/小三15/四号14/小四12/五号10.5/小五9/六号7.5", "请输入字号大小！（必须输入数字！）", "18")
    If z = "" Then GoTo InputSize
    If IsNumeric(z) = False Then GoTo InputSize
    If z < 1 Or z > 42 Then GoTo InputSize
    strSize = z

'执行
    If MsgBox("选择结果：" & x & "/" & strFont & "/" & z & "磅！是否继续？", vbYesNo + vbExclamation, "查找颜色/字体/字号") = vbNo Then End
    For Each i In ActiveDocument.Paragraphs
        i.Range.Select
        If e = 1 Then
            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 = strColor And Selection.Characters.Last.Font.Name = strFont) And Selection.Characters.Last.Font.Size = strSize Then
                        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                        If (Selection.Characters.Last.Font.Color = strColor And Selection.Characters.Last.Font.Name = strFont) And Selection.Characters.Last.Font.Size = strSize Then
                            Do
                                If Selection.Characters.Last.Text = vbCr Then Exit Do
                                If (Selection.Characters.Last.Font.Color = strColor And Selection.Characters.Last.Font.Name = strFont) And Selection.Characters.Last.Font.Size = strSize 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 = strColor: Selection.Font.Name = strFont: Selection.Font.Size = strSize
                        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
        ElseIf e = 2 Then
            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 = strColor And Selection.Characters.Last.Font.Name = strFont) And Selection.Characters.Last.Font.Size = strSize Then
                    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                    If (Selection.Characters.Last.Font.Color = strColor And Selection.Characters.Last.Font.Name = strFont) And Selection.Characters.Last.Font.Size = strSize Then
                        Do
                            If Selection.Characters.Last.Text = vbCr Then Exit Do
                            If (Selection.Characters.Last.Font.Color = strColor And Selection.Characters.Last.Font.Name = strFont) And Selection.Characters.Last.Font.Size = strSize 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 = strColor: Selection.Font.Name = strFont: Selection.Font.Size = strSize
                    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-7-3 09:08
*****************
Sub 全文查找_红色宋体小二_前后添加书名号_通用()
    Dim i As Paragraph, e As Lon ...

师傅好！

你的技术以前没有全拿出来，今天试了Sub 全文查找_红色宋体小二_前后添加书名号_通用() 这个宏，感觉象官方出品的味道，功能象“瑞士军刀”，什么都能干，真得好用、这到勾起了我的贪心，可不可以再把选字体、颜色、字号这3个步骤直接设计成点框内上面的字体、颜色、字号，不要再另外输入，点选后确定即可。

另外、在全文插入符号时：

1、文字内有其它符号时，如：［］、＼X、插入的符号会插入到符号内。

2、能不能在一行文字中碰到类似这样两边有符号的不插入。

3、在执行单行插入时在符号外插入。

还有在插入＼X符号时，文字内原有＼X符号的地方，前面会插入一个，后面会插入2个，能不能设计成有相同符号的地方不插入。

师傅、我又要捧你了，你是最棒的，你是蓝波湾（不会英文就用中文）。

师傅、191楼的2张图片请用全文字格式重发一次给我、谢谢！

413191246se

楼主（徒弟）：191楼是一张图片，不是两张！另外，已不必再文字描述了，操作步骤都在程序中，详见附件中使用方法（将附件解压到 D 盘根下或 E 盘根下）
附件： 查找红小宋（详见使用方法）.rar (3.96 KB, 下载次数: 3)

2015-7-4 12:18 上传

点击文件名下载附件