1

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

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

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

在此处输入图像描述

编辑： 我最后有两个段落中断，它们只是用另外两个替换。我实际上是手动尝试选择和替换它们..同样的事情，它们只是出于某种原因用额外的替换。我不知道那是什么，也许它是一个不同的特殊字符？

4

3 回答 3

2 
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 找不到任何内容或位于 Document 末尾时，它会退出。

如果你知道一行中有多少段的上限，你可以用不同的方式来做。例如，如果您知道不超过 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
于 2013-04-16T21:52:23.790 回答
1

尝试这个

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
于 2013-04-16T11:31:52.280 回答
1

您不需要触发整个子程序，但可以像这样返回几行：

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。

于 2013-04-16T11:51:50.393 回答