Question

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

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

在我运行之后，循环永远不会结束，我最终会在文档的底部形成这种形式。请注意，它确实有效，然后卡住了。

enter image description here

编辑：我最后有两个段落，他们只用另外两个替换。我实际上是手动尝试选择并替换它们。同样的，它们只是因为某种原因而更换了一个。我不知道那是什么，也许是一个不同的特殊角色？

Answer 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

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

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

为什么不能找到两个回车呢？奇。无论如何，我不喜欢改变选择或GoTo所以我包括我的版本。当Find无法找到任何内容或文档末尾时，它会退出。

如果您知道连续多少段落的上限，您可以采用不同的方式。例如，如果您知道不超过10个空白段落，则可以执行此操作：

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

Answer 2

试试这个

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

Answer 3

你不需要解雇整个sub，但是回过头几行：

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

我测试了它，它与我的Word 2010一起工作正常。

VBA WORD：删除双段标记

3 个答案: