问题描述
尝试通过此过程移动过多的段落间隙.
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:删除双段标记的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!