如何打开两个文档并将文本从一个复制到另一个？

Question

我有两个文档。（title.docx和style.docx）。 我需要用title.docx文件text替换文本（斜体格式）。 我尝试了以下代码。 但是，它会将style.docx文件的所有内容都斜体化，而不是仅将特定文本（来自title.docx）斜体化。

Sub OpenDoc()


Documents.Open FileName:="C:\Documents and Settings\quads\Desktop\title.docx", ConfirmConversions:=True

 Dim char As Long
Dim x As Long
Dim count As Integer


Selection.HomeKey Unit:=wdStory, Extend:=wdMove
x = ActiveDocument.BuiltInDocumentProperties("NUMBER OF LINES")
For i = 0 To x
char = Selection.EndKey(Unit:=wdLine, Extend:=wdMove)
If (char > 0) Then
Selection.HomeKey Unit:=wdStory, Extend:=wdMove
Selection.MoveDown Unit:=wdLine, count:=i
Selection.Expand wdLine
'MsgBox (Selection.Text)
Documents.Open FileName:="C:\Documents and Settings\quads\Desktop\style.docx"
Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Italic = True
    With Selection.Find
        .Text = _
            Selection.Text

        .Replacement.Text = _
            Selection.Text
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute


End If
ActiveDocument.Application.Selection.MoveDown Unit:=wdLine, count:=1
Selection.HomeKey Unit:=wdLine, Extend:=wdMove
Next i

我需要将title.docx文件文本替换为style.docx文件文本（斜体格式）。
例如：title.docx

---

This is a testing text
This is a example text
This is a sample text

---

style.docx

---

它包含一些文本以及其他一些文档的内容，这也是一个测试文本，也将与本文档混合。

如果此行的内容为“这是本文档中的示例文本”，则也需要将其斜体。

然后，这是文档的最后一行，这是示例文本。

---

预期输出：style.docx

---

它包含一些文本以及其他一些文档的内容， 这也是一个测试文本，也将与本文档混合。

如果此行的内容为“ 这是本文档中的示例文本” ，则也需要将其斜体。 然后，这是文档的最后一行， 这是示例文本 。

---

Answer 1

在Word中打开新文件，在其中添加以下宏并将其保存在同时包含title和style文件的文件夹中。 我假设您搜索的每个文本都在title文件的单独段落中。 当我尝试和测试它时，解决方案可以正常工作。

Sub OpenDoc()

    Dim docTitle As Document
    Dim docStyle As Document
    Set docTitle = Documents.Open(FileName:=ThisDocument.Path & "\title.docx", ConfirmConversions:=True)
    Set docStyle = Documents.Open(FileName:=ThisDocument.Path & "\style.docx", ConfirmConversions:=True)

    Dim char As Long
    Dim x As Long
    Dim count As Integer


    Dim Para As Paragraph

    For Each Para In docTitle.Paragraphs

        If Len(Para.Range.Text) > 1 Then


        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Font.Italic = True
            With Selection.Find
                .Text = Left(Para.Range.Text, Len(Para.Range.Text) - 1)
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = True
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            Selection.Find.Execute Replace:=wdReplaceAll

        End If
        ActiveDocument.Range(0, 0).Select

    Next Para
End Sub