简体   繁体   中英

select a range of text from one Word doc using vba and copy to end of another document and RETAIN formatting

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

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM