使用 vba 从一个 Word 文档中选择一系列文本并复制到另一个文档的末尾并保留格式

Question

我有一个文档“mydoc1”，其中包含标题“参加考试”和“提出问题”，在这些标题中选择了要复制到另一个文档“mydoc2”末尾的文本。但是，该选择具有特定的格式，当我复制并粘贴到另一个文档中时，我想保留这些格式。它的工作正常，除了复制时没有保留格式。

Sub CutSection()
'
' CutSection Macro
'
' Purpose: display the text between (but not including)
' the words "Take the Exam" and "Ask a Question" if they both appear.
Dim rng1 As Range
Dim rng2 As Range

Dim strTheText As String

Documents.Open FileName:="/Users/xxx/Desktop/mydoc1.docx"

Set rng1 = ActiveDocument.Range
If rng1.Find.Execute(FindText:="Take the Exam") Then
    Set rng2 = ActiveDocument.Range(rng1.End, 
    ActiveDocument.Range.End)
    If rng2.Find.Execute(FindText:="Ask a Question") Then
        strTheText = ActiveDocument.Range(rng1.End, rng2.Start).Text
        MsgBox strTheText
    End If
End If

Documents("/Users/xxx/Desktop/mydoc2.docx").Activate
ActiveDocument.Content.InsertAfter strTheText

End Sub

Answer 1

字符串不包含任何格式数据，只有文本。

您可以简单地复制并粘贴文本：

Sub CutSection2()
   Dim doc1 As Document, doc2 As Document
   Dim rng1 As Range, rng2 As Range

   Set doc1 = Documents.Open(FileName:="/Users/xxx/Desktop/mydoc1.docx")
   Set doc2 = Documents("/Users/xxx/Desktop/mydoc2.docx")

   Set rng1 = doc1.Range
   If rng1.Find.Execute(FindText:="Take the Exam") Then
      Set rng2 = doc1.Range(rng1.End, doc1.Range.End)
      If rng2.Find.Execute(FindText:="Ask a Question") Then
         doc1.Range(rng1.End, rng2.Start).Copy
         doc2.Characters.Last.PasteAndFormat wdFormatOriginalFormatting
      End If
   End If
End Sub

或者，最好的选择是，您可以使用FormattedText 属性在不使用剪贴板的情况下传输文本。

Sub CutSection3()
   Dim doc1 As Document, doc2 As Document
   Dim rng1 As Range, rng2 As Range

   Set doc1 = Documents.Open(FileName:="/Users/xxx/Desktop/mydoc1.docx")
   Set doc2 = Documents("/Users/xxx/Desktop/mydoc2.docx")

   Set rng1 = doc1.Range
   If rng1.Find.Execute(FindText:="Take the Exam") Then
      Set rng2 = doc1.Range(rng1.End, ActiveDocument.Range.End)
      If rng2.Find.Execute(FindText:="Ask a Question") Then
         doc2.Characters.Last.FormattedText = doc1.Range(rng1.End, rng2.Start).FormattedText
      End If
   End If
End Sub