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

413191246se

楼主，129楼三个宏就是昨天你需要的三个宏，不必做任何修改了！
你楼上这个宏，我也没好好看，我就提供一下把前天的四五个宏组合在一起的宏吧！（在新的宏 Sub XXX()...End Sub里，只须把其它的宏名拷贝到此宏即可运行它了，也叫引用；不需要的宏可以删除，也可以注释掉）
Sub 颜色合用()
'只须把每个分过程(Sub...End Sub)的过程名拷贝到此过程即可
    首字白色
    首字紫色
    次字黄色
    三字黑色
    四字红色
End Sub

13907933959

413191246se 发表于 2015-6-22 19:12
楼主，129楼三个宏就是昨天你需要的三个宏，不必做任何修改了！
你楼上这个宏，我也没好好看，我就提供一 ...

前辈好！
还是运成不了，我也不知错在那里，实在是不懂，还是麻烦你把这个代码放到电脑里运行一下、给改一下，我也知道以占用了你太多时间和精力，实在是愧疚，我也知道很烦人，也实在是不得以，恳请前辈体谅继续帮帮我这个外行，拜托、拜托！！！
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 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

413191246se

楼主，上楼代码纠错结果如下：（如果你对我编的各个小过程满意，可以只把过程名称拷贝到一个宏里面即可，这样可少出错。这几段代码效果都互相抵消了，我感觉。——如不满意，可继续跟帖发出新问题，我重新编辑。）
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
   
'查找黄色某词替换为无
   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
    End With
   
'查找黄色替换为黑色
    With ActiveDocument.Content.Find
        .Font.Color = wdColorYellow
        .Replacement.Font.Color = wdColorBlack
        .Execute FindText:="", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
    End With
End Sub

13907933959

413191246se 发表于 2015-6-22 22:41
楼主，上楼代码纠错结果如下：（如果你对我编的各个小过程满意，可以只把过程名称拷贝到一个宏里面即可，这 ...

前辈好！
程序运行正常，可不知为什么第3步“查找小二/黄色替换为红色”这个没有实现，最后还是被替换成了黑色，真是不好意思、还要劳请你再看一看，谢谢！

413191246se

楼主，你第三步弄丢了一行语句：        .Execute FindText:="", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
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
   
'查找黄色某词替换为无
   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
        .Execute FindText:="", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
    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

另外，楼主你说下箭头是不是全插入再删除的？不是的，是指符合条件的段落最后一行前面插入下箭头，如果增多一行，则选定此段落删除下箭头（不符合条件的段落是不会插入下箭头的）。
还有，楼主你的“颜色合并”的目的是干什么？如果仍未达到目的，你重新叙述一下要达到什么样的效果，我好再给你编。

13907933959

413191246se 发表于 2015-6-23 11:05
另外，楼主你说下箭头是不是全插入再删除的？不是的，是指符合条件的段落最后一行前面插入下箭头，如果增多 ...

     前辈好！

    笨徒弟总是让师父多费心血，外行总是问题多，这一段时间对你的不断打扰，还请师父多多包容、多多原谅，程序经你修改纠错后运行正常，完美解决问题，我也可以轻松一下了，徒弟耗费了你太多心血和时间深表歉意，可对我们学医的又有个忌口，不能说：“以后有事找我、欢迎再来”之类的话，何况我还是个刚入门学业未成的。总之我会永远记得在ExcelHome技术论坛里有位413191246se的前辈曾多次帮过我的大忙，古话说得好，大恩不言谢！

    別的不说了，还是来句老套的，祝你全家幸福安康，万事如意！虽然祝福的句子是老套的，但这是我发自内心对你全家的祝福！真的、前辈！真诚得感谢你、谢谢！谢谢！

    不过、还请师傅允许我以后还有再向你救教的资格！这个还请师傅千万要恩准！！！

413191246se

    一、楼主不必太客气，我能帮忙一定帮。——其实我也是会录制宏很多年，但是真正懂编辑VBA代码仅仅是2011年6月才开窍的，以前确实懵懂无知。
    二、我还是建议楼主，什么时间抽出一个专门时间段，好好学一学微软官方VBA帮助，相信，你在录制宏的基础上（现在也会编辑一定的VBA宏代码了！）会有一定的提高，对于以后从事医学资料整理也有好处。
    三、楼主，我有——Word2003 通用模板（夏季版）2015-6-5，如果你有兴趣可以下载试用（在 C 盘查找 Normal.dot，并勾选高级搜索，不管有一个还是两个，找到 Normal.dot 这个通用模板后，删除它，但要记住当前文件夹路径，并把我的空白通用模板 Normal.dot 放到刚才的文件夹中，删除旧 Normal.dot 要事先关闭 Word2003，再打开 Word），如果不需要我的模板，可以不必下载。
我的模板下载页面：http://club.excelhome.net/thread-1209664-1-3.html

13907933959

413191246se 发表于 2015-6-23 15:52
一、楼主不必太客气，我能帮忙一定帮。——其实我也是会录制宏很多年，但是真正懂编辑VBA代码仅仅是201 ...

前辈好！

你真是一个良师益友加兄长，能有幸认识你真是运气加福气，有时间一定按你说的做，这不是敷衍你，确实是时间少，我和师兄5个人每天只睡5～6个小时，现在更少，要全手工逐行校对整理上次的700本书，由于我“作出了突出贡献”，这些书师傅没有分任务给我，我还是整理医案、病例、药材、病人资料，他们可惨了平均每人175本，最长的一本书有将近9千页，短的也有170多页，他们至少在这半年的时间是没有喘气的时间，他们忌妒死我了，开玩笑说师傅偏袒我，师傅说他们有不有良心，说我一个人做了95％，他们几个人才干5％，师兄们说我有神仙答救，师傅说你们现在也去找一个来答救你们的，我看得出这次整理这700本书师傅是高兴的，用心也是良苦、他是想通过让徒弟们整理这些本书来看看这些书。

前辈、我又碰到了难题了，要你这位神仙答救答救我！

怎样把下面这些病人名单排列成图片上的排列方式（不是搞成图片）。

duquancai

13907933959 发表于 2015-6-24 08:06
前辈好！你真是一个良师益友加兄长，能有幸认识你真是运气加福气，有时间一定按你说的做，这不是敷衍你， ...

你的文档特点：1、整个文档只有1个段落组成；2、文档中人名之间只有一种符号“、”。
所以可以：1、文本转换为表格（自己根据需要定义列数，比如10列）2、调整好后隐藏表格框线。