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

时间:2014-11-27 08:31:30

标签: vba ms-word word-vba

我有两个文件。(title.docx和style.docx)。我需要用title.docx文件文本替换文本(用斜体格式)。我尝试了以下代码。但它斜体显示了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


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

如果此行有这是本文档中的示例文本,那么这也需要用斜体显示。 然后这是文档的最后一行。这是一个示例文本


1 个答案:

答案 0 :(得分:0)

在Word中打开新文件,在其中添加以下宏并将其保存在同时包含titlestyle文件的文件夹中。我假设您搜索的每个文本都在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