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

13907933959

413191246se 发表于 2015-6-25 19:54
楼主，我发现我说得越多，你越不理解。我怀疑你是否认真阅读了我的回复。
1、不说宏，只说选定了几个字或 ...

   师傅好！

    不气坏师傅不算好徒弟，请师傅赦罪！师傅对徒弟的问题不直接给答案，其用心良苦徒弟明白，是要徒弟慢慢琢磨慢慢领悟，这样学的东西才能更多更牢。

    徒弟“认真”阅读了你的回复，可由于外行再加上个笨老瓜，段落格式：段前/段后必须为0 这个昨天还是未注意到，经师傅你点化后，行距OK了。

    姓名排列宏也OK了，在输入8列后，名单变成竖向排列，再调上面哪个限制宽度的框就好了。


    录制一个只有两个动作的宏：全选/左方向键。再观察一下代码。


Sub Macro3()
'
' Macro3 Macro
' 宏在 2015-6-26 由 User 录制
'
    Selection.WholeStory
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
End Sub

    这个徒弟还是不明白该怎么办？还恳请师傅细细点化！


    1、如果这个宏的第一句或第二、三句，就是Selection.WholeStory全选语句，而后面还有很多的操作步骤，可能是建立在这全选语句的基础上的，也是放在全选语句的后面吗？
   
    2、这个宏里面没有一句Selection.WholeStory全选语句（而运行这个宏程序结束后、文档还总是处于全选状态）。

413191246se

1、楼主，日常排版中，取消文档网格和让段前、段后为0，这样才能使文档比较紧密，妥妥帖帖。
2、不好意思，我也没深刻领会你的问题。——如果你发现某个宏执行完毕后，仍然是选定状态，只须将Selection.MoveLeft Unit:=wdCharacter, Count:=1这一行语句放在该宏后面即可（但要放在该宏的 End Sub 语句前）。上、下、左、右，只须一个动作就可以，四个动作就是可以任选。你想想：平时用鼠标勾选一些文字，是不是只须动一下方向键，选定就取消了？就是这样，录制成宏就可以了。
3、姓名排列宏：请先将所有人名（以后不要在人名后面加句号了）保存在一个新建文档中，然后用该宏，让你输入列数，可以随便输入数字（但是限定范围是1-63列），我个人认为须在 6-8列左右，你不必拘泥于8列。如果8列宽，换成7列也可，6列也可，5列也可；这个列数你可以试验，满意后保存。
4、楼主，我有——Word2003 通用模板，前几天提供给你链接了，如果你经常要排版的话，用它可以初步地自动排版，一般是一键完毕（查找C盘隐藏文件 Normal.dot，记住路径，用我的模板替换它，此前关闭WORD，再打开WORD即可）。

413191246se

楼主，操作文本有两种方法：一是录制宏，用的是 Selection 对象，这种方法光标会移动，效率不高；二是无须录制，直接在VBE中编程，用 ActiveDocument 对象，光标一般执行完毕仍在原地未动。两种方法都能达到同样的目的。

13907933959

duquancai 发表于 2015-6-26 09:01
看了你的截图，你不是已经转换成表格了吗？（在文本转换表格，你也可以选择“根据窗口调整表格”选项。我 ...

前辈好！
按今天你教的点选“根据窗口调整表格”选项，就可以了，感谢前辈的帮助！因对电脑差不多是零基础，再简单的问题对我来说都是难题，好在有你和413191246se这样的前辈们帮助，问题总能得以解决，希望以后继续能得到前辈的帮助，谢谢。

13907933959

413191246se 发表于 2015-6-26 10:24
1、楼主，日常排版中，取消文档网格和让段前、段后为0，这样才能使文档比较紧密，妥妥帖帖。
2、不好意思 ...

师傅好！
经你的一再细细点化，我的问题全部OK了，由于我这个外行对电脑方面的术语听不懂、看不懂，遇到问题更是描述不准，再加上文字语言功底不深，造成你的误判，浪费你很多的时间，敬请师傅原谅！
你的文档模板我还不能下载用，因我现在还没有自己的电脑，用的是我师傅的电脑，我怕他万一不适应引起不必要的麻烦，这个你懂的。
感谢的话我也不再说了，因为再多的感谢也感谢不了你对我电脑技艺的传授和帮助，师傅、徒弟下次有问题再来气你！！！罪过、罪过、请师傅饶恕徒弟。

413191246se

楼主谦虚了！虽说我用 Word 很多年，但其实掌握的 Word 知识也不深入，有时还是有解决不了的问题。
何况 VBA 宏知识也是粗浅掌握。希望咱们共同进步吧！（有问题仍然欢迎来论坛求助，我能帮一定帮。）

13907933959

413191246se 发表于 2015-6-26 19:30
楼主谦虚了！虽说我用 Word 很多年，但其实掌握的 Word 知识也不深入，有时还是有解决不了的问题。
何况 V ...

   师傅好！

   不好意思、还没有让你安静2日又要烦你了，又有问题要求教：


   1、在颜色、字体、字号段前、段后插入符号《》。
如：在红色字段前插入《      在段后指入 》
      在宋体字段前插入《      在段后指入 》
      在小二字段前插入《      在段后指入 》


   2、因电脑配置过低（笔记本1G内存），在外理大一些的文档（3～20多MB）时，也是宏里面的步骤较多，运行了一小部分就死机（试了多次都一样），在外理小的文档（1～2MB）时，该宏可正常运行，我把该宏里面的步骤拆分成多个宏（也想过把文档拆分、感觉更麻烦），运成正常并能达到要求处理文档，这样又出现了一个问题，就是要多次点多个宏按钮，很容易出错漏点某一个按钮，再一个手续也烦，我想多个宏之间能不能用一个连接的方法，这样点一个按钮让一个宏运成完了，又自动的运成下一个宏，既让它们自动运行电脑又不会死机。


   又劳师傅了，徒弟先谢过！！！

    师傅、另外在下面的代码中如我要拿掉一个<篇名>代码应如何改动？

    代码中End If   Next这2句英文是什么意思？

'<目录><篇名>前后加★▲（循环遍历所有段落）

  Dim i As Paragraph

   For Each i In ActiveDocument.Paragraphs

       If i.Range Like "<目录>*" Ori.Range Like "<篇名>" Then

           With i.Range

                .InsertBeforeText:="★" '段前插入★

                .Characters.Last.InsertBeforeText:="▲" '段后插入▲

                .Font.Color = wdColorBlue '蓝色

           End With

       End If

   Next

     师傅！

    把文档中类似下面\x×××××\x这样的句子，让它单独起一行：

    \x隆庆辛未\x   

    \x隆庆辛未夏五既望，李沈启原道卿撰。\x

    它们有的是单独一行，有的在正文的开头、中间、结尾处，我用查找替换中的查找栏内输入\\x(*)\x可以统统查找到，只是要在第一个X前面多加一条斜杠，可照此方法录制的宏却查找不到。

SubMacro3()

'

'Macro3 Macro

' 宏在 2015-6-28由 User 录制

'

    Selection.Find.ClearFormatting

    With Selection.Find

        .Text = "\\x(*)\x"

        .Replacement.Text = ""

        .Forward = True

        .Wrap = wdFindContinue

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchByte = False

        .MatchAllWordForms = False

        .MatchSoundsLike = False

        .MatchWildcards = True

    End With

EndSub

   只能求师傅再编一段让它单独起一行代码。

413191246se

'楼主，因为你未说清颜色/字体/小二字段（这个字段中是纯粹的颜色/宋体/小二还是有多种格式没明说，我就不具体查找这些字段了，你先手动选定某个区域文字）

'选定区域前面插入“《”（双引号）
    Selection.InsertBefore Text:="《"

'选定区域后面插入“》”（双引号）
    Selection.Characters.Last.InsertBefore Text:="》"
   
'text:后面双引号之间的文字可以任意更换,如： Selection.InsertBefore Text:="China"

'假设有一个宏：Sub China()...End Sub，它的宏名是：China（Sub字样和空格都不要，后面的一对半角括号也不要）
'假设现有 3 个宏：宏1/宏2/宏3，要想联用，只须新建一个宏：总宏（什么名字都可以），然后把各个宏名拷贝到总宏中，执行总宏即可
Sub 总宏()
    宏1
    宏2
    宏3
End Sub

'如果想保留<目录>而删除<篇名>代码，只须将 If i.Range Like "<目录>*" Or i.Range Like "<篇名>" Then 这句代码改为
'       If i.Range Like "<目录>*" Then 即：将从 Or 到 Then 之前的文字拿掉
'条件语句：If...Then...End if 这是配套的（意思：如果……则……，比如：If A>0 then msgbox"A是正数"（如果A大于0，则A为正数））
'循环语句：For Each...Next，配套的，循环遍历某个对象集合，如：自动排版一般要循环遍历每个段落，就是把所有段落都经过设置）
******
'让\x隆庆辛未夏五既望，李沈启原道卿撰。\x这样的字符单独一行：（宏代码）
Sub find_x()
'查找 \x隆庆辛未\x 字样，使之单独成段
    Selection.HomeKey Unit:=wdStory
    Do
        Selection.Find.Execute findtext:="\x", Forward:=True, Wrap:=wdFindStop
        If Selection.Find.Found = False Then Exit Do
        Do
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If Right(Selection, 2) = "\x" Then
                Selection.Font.Color = wdColorRed '红色（不想要颜色，可删除此行语句！）
                Selection.InsertParagraphBefore
                Selection.InsertParagraphAfter
                Selection.MoveStart Unit:=wdCharacter, Count:=1
                Exit Do
            End If
        Loop
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    Loop
End Sub
****************楼主，以下提供三个有用的代码，任何时候可以使用：
Sub 删除空行()
'删除换行符假回车
    With ActiveDocument.Content.Find
        .Execute findtext:="^l", replacewith:="^p", Replace:=wdReplaceAll
        .Execute findtext:="^13", replacewith:="^p", Replace:=wdReplaceAll
    End With
'删除段落首尾空格
    Selection.WholeStory
    CommandBars.FindControl(ID:=122).Execute
    CommandBars.FindControl(ID:=123).Execute
'删除空行
    Dim i As Paragraph
    For Each i In ActiveDocument.Paragraphs
        If Len(i.Range) = 1 Then i.Range.Delete
    Next
End Sub
*************
Sub 删除段落首尾空格()
    Selection.WholeStory
    CommandBars.FindControl(ID:=122).Execute
    CommandBars.FindControl(ID:=123).Execute
End Sub
*************反复测试宏代码可以用《重新打开》宏，但这个宏很危险，它不保存任何修改！切记！
Sub 重新打开()
    Dim i As String
    i = ActiveDocument.FullName
    If Mid(i, 2, 1) <> ":" Then Exit Sub
    If ActiveDocument.Saved = False Then
        ActiveDocument.Close savechanges:=wdDoNotSaveChanges
        Documents.Open FileName:=i
    End If
End Sub
*********再提供一个简单的《自动排版》宏（将它放到工具栏上，可以常用，或定义热键为F4/F11等）：
Sub 自动排版()
    On Error Resume Next
    With ActiveDocument.Content.Find
        .Execute findtext:="^l", replacewith:="^p", Replace:=wdReplaceAll
        .Execute findtext:="^13", replacewith:="^p", Replace:=wdReplaceAll
    End With
    Selection.WholeStory
    CommandBars.FindControl(ID:=122).Execute
    CommandBars.FindControl(ID:=123).Execute
    Dim i As Paragraph
    For Each i In ActiveDocument.Paragraphs
        If Len(i.Range) = 1 Then i.Range.Delete
    Next
    Selection.WholeStory
    Selection.ClearFormatting
    Selection.ClearFormatting
    With Selection.Font
        .Size = 14
        .Kerning = 0
        .DisableCharacterSpaceGrid = True
    End With
    With Selection.ParagraphFormat
        .LineSpacing = LinesToPoints(1.25)
        .CharacterUnitFirstLineIndent = 2
        .AutoAdjustRightIndent = False
        .DisableLineHeightGrid = True
    End With
    With ActiveDocument
        .Paragraphs(1).Range.InsertParagraphBefore
        .Paragraphs(2).Range.InsertParagraphAfter
        With .Range(Start:=0, End:=.Paragraphs(3).Range.End)
            .Style = ActiveDocument.Styles(wdStyleHeading1)
            With .ParagraphFormat
                .SpaceBefore = 0
                .SpaceAfter = 0
                .LineSpacing = LinesToPoints(1.15)
                .Alignment = wdAlignParagraphCenter
                .AutoAdjustRightIndent = False
                .DisableLineHeightGrid = True
            End With
        End With
        .Paragraphs(1).Range.Font.Size = 21
        .Paragraphs(3).Range.Font.Size = 26
    End With
    ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit
    Selection.HomeKey Unit:=wdStory
End Sub

13907933959

413191246se 发表于 2015-6-28 12:44
'楼主，因为你未说清颜色/字体/小二字段（这个字段中是纯粹的颜色/宋体/小二还是有多种格式没明说，我就不 ...

师傅好！

耽误你中午休息，真是抱歉！

你给的2句代码，我还是不会用，这几段还要求师傅编可分开用的代码。

在颜色、字体、字号段前、段后插入符号《××××××××》。

1、在文档内单独一行的红色字句前面插入《       字句后面指入 》

2、在文档内单独一行的宋体字句前面插入《       字句后面指入 》

3、在文档内单独一行的小二字句前面插入《       字句后面指入 》

4、在文档内红色字（正文行中含有红色字句）的前面插入《       字句后面指入 》

5、在文档内宋体字（正文行中含有宋体字句）的前面插入《       字句后面指入 》

6、在文档内小二字（正文行中含有小二字句）的前面插入《       字句后面指入 》

7、句子开头和结尾带有符号的如：［］ 、＼X  改变颜色，如：黑色改为紫色

8、句子开头和结尾带有符号的改变字体，如：宋体改为楷体

9、句子开头和结尾带有符号的改变字号，如：小二改为小五

谢谢师傅在我遇到难题的时候总是及时出现，徒弟拜谢师傅！

413191246se

楼主，虽然你把我捧上了天，但我知道我水平高低，昨晚并未出结果，今天刚才终于成功！（我其实是VBA小菜鸟，不是高手！）——但限于时间，仅成功两个宏，余下的下午再说（昨晚还走了弯路，以为你要在单行每段前后加书名号呢！你的“字句”两字，应该改为“文字”才好）：
**************
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.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
                    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.Name = "宋体" Then
                    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                    If Selection.Characters.Last.Font.Name = "宋体" Then
                        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 = "宋体"
                    Selection.InsertAfter Text:="》"
                    Selection.MoveRight Unit:=wdCharacter, Count:=1
                Else
                    Selection.MoveRight Unit:=wdCharacter, Count:=1
                End If
            Loop
        End If
    Next
End Sub