把超过一行的段落前后（段首、段尾）增加一个段落符

13907933959

前辈们好！

求前辈帮忙，把超过一行的段落前后（段首、段尾）增加一个段落符，未满行或刚满行的段落则不增加。

谢谢！

duquancai

Sub AddVbcr()
    Dim d As Document
    Set d = ActiveDocument
    For i = d.Paragraphs.Count To 1 Step -1
        If d.Paragraphs(i).Range.ComputeStatistics(1) > 1 Then
            d.Paragraphs(i).Range.InsertAfter vbCr
            d.Paragraphs(i).Range.InsertBefore vbCr
        End If
    Next
End Sub

13907933959

duquancai 发表于 2017-8-18 12:26
Sub AddVbcr()
    Dim d As Document
    Set d = ActiveDocument

杜前辈好！
有难题总能得到前辈的相助，心里感激！！！
刚才在 “模拟附件” 上测试了，代码精准，后又在比较大（3MB）的单个文档上测试，处理了28分钟左右，文档还没处理完电脑死机，试了3遍都一样，这个可能是电脑的配置跟不上，前辈有不有办法让它处理的速度变得快一些？因我处理的大文档比较多，在下拜谢！

jiminyanyan

13907933959 发表于 2017-8-19 07:05
社前辈好！
有难题总能得到前辈的相助，心里感激！！！
刚才在 “模拟附件” 上测试了，代码精准，后又 ...

哈，兄弟，你好换电脑了…………。

13907933959

jiminyanyan 发表于 2017-8-19 07:46
哈，兄弟，你好换电脑了…………。

前辈好！
电脑是好的，平时也够用，再说经济也不富裕呀！

小花鹿

duquancai 发表于 2017-8-18 12:26
Sub AddVbcr()
    Dim d As Document
    Set d = ActiveDocument

判断行数............................................................................................................

duquancai

13907933959 发表于 2017-8-19 07:05
社前辈好！
有难题总能得到前辈的相助，心里感激！！！
刚才在 “模拟附件” 上测试了，代码精准，后又 ...

Sub AddVbcr()
    Dim mts As Object, reg As Object, n&, m&, chanum&, doc As Document
    Set doc = ActiveDocument: chanum = doc.PageSetup.CharsLine
    Set reg = CreateObject("vbscript.regexp")
    reg.Global = True: reg.MultiLine = True
    reg.Pattern = "^[^\r]{" & chanum & ",}\r"
    Set mts = reg.Execute(doc.Content.Text)
    If Not mts Is Nothing Then
        For j = mts.Count - 1 To 0 Step -1
            m = mts(j).FirstIndex: n = mts(j).Length
            With doc.Range(m, m + n)
                If .ComputeStatistics(1) > 1 Then
                    .InsertAfter vbCr
                    .InsertBefore vbCr
                End If
            End With
        Next
    End If
End Sub

13907933959

duquancai 发表于 2017-8-19 10:56
Sub AddVbcr()
    Dim mts As Object, reg As Object, n&, m&, chanum&, doc As Document
    Set d ...

杜前辈好！
这个代码较上一个代码速度可能快了一半左右，刚才在上午3MB的单个文档上测试了，耗时 16分半钟左右处理完毕，代码同样精准无误，电脑也没有出现死机现象。前辈辛苦了！拜谢前辈！

jiminyanyan

13907933959 发表于 2017-8-19 15:31
社前辈好！
这个代码较上一个代码速度可能快了一半左右，刚才在上午3MB的单个文档上测试了，耗时 16分半 ...

哈哈，是杜前辈，不是社……。

duquancai

13907933959 发表于 2017-8-19 15:31
社前辈好！
这个代码较上一个代码速度可能快了一半左右，刚才在上午3MB的单个文档上测试了，耗时 16分半 ...

16分钟左右！！！90年代的电脑吗？