MS WORD将段落中的每个句子复制三份

Question

我有数百页的长文档，其中包含表格和图像。表格包含垂直和水平合并的单元格。为了在阅读时更容易掌握，我把一个段落中的每个句子重复三遍，尤其是在使用MS Word的"朗读"功能时。我想出了以下VBA代码的三倍。它可以工作，但需要很长时间，特别是对于长文件有什么建议可以加快速度吗?或者甚至是不同的代码，甚至可以在垂直合并的单元格表中更快地工作

Sub TriplicateSentencesin_each_Paragraph()
'Each paragraph must have a period at the end
'First I replace each paragraph period with 3 periods to allow 
'for the loop through 'paragraphs to end of doc
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = ".^p"
.Replacement.Text = "...^p"
.Execute REPLACE:=wdReplaceAll
End With
Application.ScreenUpdating = False
Selection.HomeKey Unit:=wdStory
Dim IsFound As Boolean
IsFound = True
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "...^p"
.Replacement.Text = ".^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
While IsFound
Selection.HomeKey Unit:=wdLine
Selection.Find.Execute REPLACE:=wdReplaceOne

Selection.MoveUp Unit:=wdParagraph, count:=1
Selection.MoveRight Unit:=wdSentence, count:=1, Extend:=wdExtend
Selection.Copy
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Selection.TypeText Text:=" "
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Selection.TypeText Text:=" "
Selection.PasteAndFormat (wdFormatOriginalFormatting)


Selection.MoveRight Unit:=wdCharacter, count:=3
Selection.HomeKey Unit:=wdLine
IsFound = Selection.Find.Execute
Wend
End Sub

Answer 1

根据您所描述的，您所需要的只是一个通配符查找/替换(甚至不是宏)，其中:

Find = [!^13]@[.!?]
Replace = ^& ^& ^&

或者作为宏:

Sub Triplicates()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[!^13]@[.!?]"
.Replacement.Text = "^& ^& ^&"
.Forward = True
.Format = False
.MatchWildcards = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub

注意以?结尾的句子和!