VBA WORD：删除双段落标记答案

【问题标题】：VBA WORD: Remove double paragraph marksVBA WORD：删除双段落标记
【发布时间】：2013-04-17 05:52:23
【问题描述】：

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

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

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

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

【问题讨论】：

一个提示，这可能很奇怪...我复制了你的 sub 但它不起作用。然后 Siddharth 的也不起作用。然后我创建了我的工作。我做了一些其他的事情，关闭了应用程序并再次尝试了所有潜艇。所有的子程序都开始按预期工作——你的、Siddhard 的和我的……不知道为什么……
好提示！似乎正在工作。我仍然有那一串奇怪的段落标记，但它们只是在结尾，并且循环不会卡住。所以在这里！
虽然现在它似乎出于某种原因删除了我的内嵌图片！？知道那是什么意思吗？
没关系 ..我回到 ^13 通配符，它就可以工作了...哇哦！
您的模块中是否包含所有三个子组件或只有一个？我刚刚再次打开文档，只有我的在工作……奇怪……

标签： vba ms-word

【解决方案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 找不到任何内容或位于 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

【讨论】：

【解决方案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

【讨论】：

没有工作:(同样的问题我最后有两个段落中断，它们只是用另外两个替换。我实际上是手动尝试选择和替换它们..同样的事情，它们只是替换出于某种原因，多了一个。知道那是什么意思吗？

【解决方案3】：

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

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。

【讨论】：