VBA WORD:删除双段落标记 [英] VBA WORD: Remove double paragraph marks

问题描述

尝试通过此过程移动过多的段落间隙.

Trying to move excessive paragraph gaps via this procedure.

Sub RemoveGaps()
    wrdDoc.Content.Select

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting

    With Selection.Find
        .Text = "^13^13"
        .Replacement.Text = "^p"

        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = True
    End With

    Selection.Find.Execute Replace:=wdReplaceAll
    If Selection.Find.Found = True Then
        Call RemoveGaps
    End If

End Sub

在我运行它之后，循环永远不会结束，我最终在文档底部出现了这种形式.请注意，它确实工作了一段时间然后卡住了.

After I run it the loop never ends and I end up with this kind of formation at the bottom of the document. Note that it does work for a bit then gets stuck.

我在末尾有两个段落分隔符，它们只是替换为另外两个段落.实际上，我手动尝试选择和替换它们……同样的事情，出于某种原因，它们只是替换了一个额外的.我不知道那是什么，也许是不同的特殊字符?

I have two paragraph breaks at the end and they just replace with another two. I actually went manually to try to select and replace them ..and same thing, they just replace with an extra one for some reason. I don't know what that's about, perhaps its a different special character?

推荐答案

Sub RemoveGaps()

    Dim oFnd As Find

    Set oFnd = ThisDocument.Content.Find
    oFnd.ClearFormatting
    oFnd.Replacement.ClearFormatting

    With oFnd
        .Text = "^13^13"
        .Replacement.Text = "^p"

        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = True
    End With

    Do
        oFnd.Execute Replace:=wdReplaceAll
    Loop Until Not oFnd.Execute Or oFnd.Parent.End = ThisDocument.Content.End

End Sub

我不知道为什么 KazJaw 的作品 - 它仍然在末尾留下两个段落标记，但 Execute 返回 False.当我到达最后一个 GoTo 时，我会在立即窗口中看到它.

I have no idea why KazJaw's works - it still leaves two paragraph marks at the end, but Execute returns False. When I get to the last GoTo, I get this in the Immediate Window.

?selection.Find.Execute
False
?selection = string(2,chr$(13))
True

为什么它没有找到两个回车呢?奇怪的.无论如何，我不喜欢更改选择或转到，所以我包含了我的版本.当 Find 找不到任何内容或它位于文档末尾时，它会退出.

Why doesn't it find two carriage returns when that's all it is? Odd. Anyway, I don't like changing the selection or GoTo so I included my version. It quits when Find can't find anything or when it's at the end of the Document.

如果您知道一行中有多少个段落的上限，则可以采用不同的方式.例如，如果您知道不超过 10 个空白段落，您可以这样做:

If you know the upper limit of how many paragraphs there will be in a row, you could do it a different way. For instance, if you know there are no more than 10 blank paragraphs, you could do this:

Sub RemoveGaps2()

    Dim i As Long

    For i = 10 To 2 Step -1
        With ThisDocument.Content.Find
            .Text = "[^13]{" & i & ",}"
            .Replacement.Text = Chr$(13)
            .MatchWildcards = True
            .Execute , , , , , , , , , , wdReplaceAll
        End With
    Next i

End Sub

这篇关于VBA WORD:删除双段落标记的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！