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.

EDIT: 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?

回答1:

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

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

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.

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

回答2:

Try this

Sub RemoveGaps()
    wrdDoc.Content.Select

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

    With Selection.Find
        .Text = "^p^p" '<~~~ See this
        .Replacement.Text = "^p"

        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False '<~~ Set this to false
    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    If Selection.Find.Execute = True Then
        Call RemoveGaps
    End If
End Sub

回答3:

You don't need to fire whole sub but go back few lines like this:

Sub RemoveGaps()
Dim wrdDoc As Document
Set wrdDoc = ActiveDocument
    wrdDoc.Content.Select

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

    With Selection.Find
        'oryginal
        .Text = "^13^13"
        .Replacement.Text = "^p"
        .Forward = True

    End With

GoHere:
    Selection.Find.Execute Replace:=wdReplaceAll

    If Selection.Find.Execute = True Then
        GoTo GoHere
    End If

End Sub

I tested it and it works fine with my Word 2010.

来源：https://stackoverflow.com/questions/16035530/vba-word-remove-double-paragraph-marks

标签

vba

word-vba