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

Question

I have a document "mydoc1" which has headers "Take the Exam" and "Ask a Question" and within those headers is the selection of text that I want to copy to end of another document, "mydoc2". However, that selection has particular formatting which I want to retain when I copy and paste into another document. Its working ok EXCEPT the formatting is NOT being preserved when copied.

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

Strings don't contain any formatting data, only text.

You could have simply copied and pasted the text:

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

Or, the best option, you could use the FormattedText property to transfer the text without using the clipboard.

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