一个接一个地复制/粘贴两个Word文档中的后续段落（学习外语）

Question

我有两本同名的书：一本英文，一本西班牙文。 我想把它们结合起来，这样我就可以学习西班牙语了。 因此，我需要一个 Word 文档，其中包含一个英文段落，然后是西班牙文的同一段落，一遍又一遍。 以下是我手动复制/粘贴的内容，但我想使用以下模式自动执行它作为终点。 这是我到目前为止所拥有的：

Sub Macro1()
    Windows("3.doc  -  Compatibility Mode").Activate
    Selection.MoveDown Unit:=wdLine, Count:=13, Extend:=wdExtend
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.Copy
    Windows("Document2").Activate
    Windows("656398.docx  -  Compatibility Mode").Activate
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.MoveDown Unit:=wdLine, Count:=23, Extend:=wdExtend
    Selection.MoveUp Unit:=wdLine, Count:=7, Extend:=wdExtend
    Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend
    Selection.Copy
    Windows("Document2").Activate
    Windows("3.doc  -  Compatibility Mode").Activate
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.MoveDown Unit:=wdLine, Count:=8, Extend:=wdExtend
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Copy
    Windows("Document2").Activate
    Windows("656398.docx  -  Compatibility Mode").Activate
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.MoveDown Unit:=wdLine, Count:=18, Extend:=wdExtend
    Selection.Copy
    Windows("Document2").Activate
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.PasteAndFormat (wdUseDestinationStylesRecovery)
    ActiveDocument.Save
End Sub

Answer 1

例如，如果文档具有完全相同的段落：

Sub AddSecondLanguage()
Application.ScreenUpdating = False
Dim DocA As Document, DocB As Document, Rng As Range, i As Long
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Title = "Select the source document containing the primary language."
  .InitialFileName = "C:\Users\" & Environ("Username") & "\Documents\"
  .AllowMultiSelect = False
  If .Show = -1 Then
    Set DocA = Documents.Open(.SelectedItems(1), ReadOnly:=True, AddToRecentFiles:=False)
  Else
    MsgBox "No primary language file selected. Exiting.", vbExclamation: Exit Sub
  End If
End With
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Title = "Select the source document containing the secondary language."
  .InitialFileName = DocA.Path & "\"
  .AllowMultiSelect = False
  If .Show = -1 Then
    Set DocB = Documents.Open(.SelectedItems(1), ReadOnly:=False, AddToRecentFiles:=True)
  Else
    MsgBox "No secondary language file selected. Exiting.", vbExclamation
    DocA.Close SaveChanges:=False: Set DocA = Nothing: Exit Sub
  End If
End With
With DocB
  For i = .Paragraphs.Count To 1 Step -1
    Set Rng = .Paragraphs(i).Range
    Rng.Collapse wdCollapseStart
    Rng.FormattedText = DocA.Paragraphs(i).Range.FormattedText
  Next
    .SaveAs2 FileName:=Split(DocA.FullName, ".doc")(0) & "-Combined.docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
End With
DocA.Close SaveChanges:=False
Set DocA = Nothing: Set DocB = Nothing
Application.ScreenUpdating = True
End Sub

合并后的文档将以 docx 格式保存，与您打开的第一个文档同名，并在文件名中添加“-Combined”。