![](/img/trans.png)
[英]Copy/paste paragraphs in alternating manner from two Word documents into a different document (to learn a foreign language)
[英]Copy/paste subsequent paragraphs from two Word documents one after another (to learn a foreign language)
我有兩本同名的書:一本英文,一本西班牙文。 我想把它們結合起來,這樣我就可以學習西班牙語了。 因此,我需要一個 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
例如,如果文檔具有完全相同的段落:
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”。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.