批量替换章标题遇到麻烦，第1章到第99章，都要换，最后一个符号替换出问题

13907933959

treny1982 发表于 2017-8-24 20:55
哎，我有900多页，很久哦

网友好！
我个人认为杜前辈的代码是最好的，处理速度也是最快的，处理慢？请先考虑文档的大小及要处理内容的多少，电脑的配置…等，如这些因素都可排除，处理起来速度确实很慢，而要处理的文档又有很多很多个，建议你向杜前辈再求助。

treny1982

13907933959 发表于 2017-8-24 07:00
网友好！得到了帮助，应该说声谢谢，不然怎么对得起辛苦为我们写代码的前辈们！如一个谢字都没有，再求助 ...

那么把章标题，重复的删除掉呢？每个标题都有两个哦，多谢咯

13907933959

treny1982 发表于 2017-8-26 22:32
那么把章标题，重复的删除掉呢？每个标题都有两个哦，多谢咯

求助解答问题，要养成上传“测试附件”的习惯，把你的要求说清楚，这样才可能有人帮到你，如没有 “测试附件”，得到帮助的概率会很低！

treny1982

13907933959 发表于 2017-8-27 06:14
求助解答问题，要养成上传“测试附件”的习惯，把你的要求说清楚，这样才可能有人帮到你，如没有 “测试附 ...

我上传了，在上面的帖子里。

13907933959

treny1982 发表于 2017-8-27 10:57
我上传了，在上面的帖子里。

Sub 删除文档内重复的第X章()

    With ActiveDocument.Content.Find

        .Execute "第[0-9]{1,5}章：(*)第", , , 1, , , , , , "第", 2

    End With

End Sub

treny1982

13907933959 发表于 2017-8-27 14:59
Sub 删除文档内重复的第X章()    With ActiveDocument.Content.Find        .Execute "第[0-9]{1,5}章：( ...

感谢了，那么，在标题后面换行呢？然后，标题再居中呢？

13907933959

treny1982 发表于 2017-8-27 15:19
感谢了，那么，在标题后面换行呢？然后，标题再居中呢？

水平不够，等高手解答！

13907933959

treny1982 发表于 2017-8-27 15:19
感谢了，那么，在标题后面换行呢？然后，标题再居中呢？

由于还是个门外汉，花了近13个小时，好象可以实现楼主的意图了。真诚欢迎论坛上的各位前辈帮助纠错、优化、简化代码！谢谢！

Sub 删除重复的标题()

    '把文档内所有两个重复的第几章标题删除一个，删除标题的下划线，标题另起一行并居中。

   Selection.WholeStory

   Selection.Font.Underline = wdUnderlineNone

   Selection.MoveUp Unit:=wdLine, Count:=1

   With ActiveDocument.Content.Find

       .Execute "第[0-9]{1,5}章：(*)第", , , 1, , , , , , "第", 2

   End With

   With ActiveDocument.Content.Find

       .Font.Size = 15

       .Execute , , , , , , , , 1, "^p^&^p", 2

    End With

    With ActiveDocument.Content.Find

       .Execute "^13^13", , , 1, , , , , , "^p", 2

   End With

   With ActiveDocument.Content.Find

       .Font.Size = 15

       .Replacement.Font.Size = 10.5

       .Execute "^13", , , 1, , , , , , "^p", 2

   End With

   Dim i As Paragraph

   For Each i In ActiveDocument.Paragraphs

       If i.Range.Characters(1) = "第" Then

                i.Style =ActiveDocument.Styles(wdStyleSubtitle)

                With i.Range

                   With .Font

                        .Name = "宋体"

                        .Bold = False

                        .Size = 15

                        .Color = wdColorBlack

                    End With

                End With

           End If

        Next

        With Selection

              .HomeKey wdStory

        With .Find

             .ClearFormatting

             .Font.Size = 15

             .Format = True

        End With

        .Find.Execute

    End With

    Application.Run "SelectSimilarFormatting"

    With Selection.ParagraphFormat

       .Alignment = wdAlignParagraphCenter

    End With

    Selection.MoveUp Unit:=wdLine, Count:=1

End Sub

duquancai

13907933959 发表于 2017-8-29 08:50
由于还是个门外汉，花了近13个小时，好象可以实现楼主的意图了。真诚欢迎论坛上的各位前辈帮助纠错、优化 ...

下载一楼附件测试，因为你提供这个“测试附件”已经改变一楼“原始”附件的规律！！！

Sub setbiao()
    With ActiveDocument.Content.Find
        .Execute "^32{1,}", , , 1, , , , , , "^32", 2
        .Execute "(第[0-9]@章[：:][!^32]@^32)\1", , , , , , , , , "\1", 2
        .Execute "(第[0-9]@章[：:][!^32]@)^32", , , , , , , , , "^p\1^p", 2
        .Execute "^w^p", , , 0, , , , , , "^p", 2
        .Execute "^p^w", , , , , , , , , "^p", 2
        ActiveDocument.Content.ParagraphFormat.CharacterUnitFirstLineIndent = 2
        .Replacement.ParagraphFormat.Alignment = 1
        .Replacement.Font.Name = "黑体"
        .Replacement.Font.Size = 25
        .Execute "(第[0-9]@章[：:]*^13)", , , 1, , , , , , "\1", 2
    End With
End Sub

13907933959

duquancai 发表于 2017-8-29 17:59
下载一楼附件测试，因为你提供这个“测试附件”已经改变一楼“原始”附件的规律！！！

Sub setbiao()
...

  杜前辈好！

  我的“测试附件”是在楼主的12楼下载的，我也没注意它和1楼“原始”附件之间有差别，感谢前辈提醒！感谢前辈提供简洁高效的代码！在1楼的“原始”附件上测试，精准无误！

  这几天一是医院没有什么人，二是我的中医师傅去山东了，没事就瞎捉摸，拼凑了一个代码，实在是不懂，花了一天多时间才弄出来，真是惭愧！以后还请前辈多多指教！多多相助！拜谢！