将文档中的某些内容复制到特定部分的其他内容 [英] Copy certain contents from document to another at specific section

问题描述

我想将某个部分(例如文档的主题然后是主体)复制到另一个Word文档.这些文档具有不同的格式，因此我需要将其复制到文档中的预定位置.

I want to copy a certain section (e.g. subject of the document then main body) to another Word document. The documents have different formatting so I need to copy to a predetermined location in the document.

下面的代码将整个源文档复制到目标文档.

The code below copies the whole of the source document to the target document.

Sub CopyPaste()
    Dim Word As New Word.Application
    Dim WordDoc As New Word.Document    'active document
    Dim WordDoc1 As New Word.Document   'document to extract from
    Dim dialogBox As FileDialog
    Set dialogBox = Application.FileDialog(msoFileDialogOpen)
    Dim Dest_path As String
    
    dialogBox.AllowMultiSelect = False
    dialogBox.Title = "Select a file to copy from"
    
    'Show the file path and file name
    If dialogBox.Show = -1 Then
        MsgBox "You have selected: " & dialogBox.SelectedItems(1)
    End If
        
    ' Starts extracting from source document
    Set WordDoc1 = Word.Documents.Open(dialogBox.SelectedItems(1), ReadOnly:=True)
    Application.Browser.Target = wdBrowseSection
    For i = 1 To ((WordDoc1.Sections.Count) - 1)
        WordDoc1.Bookmarks("\Section").Range.Copy
    
        'Paste into an active document
        ActiveDocument.Bookmarks("\Section").Range.PasteAndFormat wdFormatOriginalFormatting
        WordDoc.ActiveWindow.Visible = True
        WordDoc1.Close
    Next i
End Sub

推荐答案

由于您显然是通过带有活动文档的Word运行此程序，因此您实际上不希望使用以下任何一种方法:

Since you're apparently running this from Word with an activedocument, you really don't want any of:

Dim Word As New Word.Application
Dim WordDoc As New Word.Document    'active document
Dim WordDoc1 As New Word.Document   'document to extract from

因为它甚至在进入对话框之前都会启动一个新的Word会话和两个新的空Word文档.

since that starts a new Word session and two new empty Word documents before you even get to the dialog.

至:

.Bookmarks("\Section")

仅适用于以下代码:

Set Rng = ActiveDocument.GoTo(What:=wdGoToSection, Name:=i)
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\section")

尝试以下方法:

Sub Replicate()
Dim DocSrc As Document, RngSrc As Range
Dim DocTgt As Document, RngTgt As Range
With Application.FileDialog(msoFileDialogOpen)
  .AllowMultiSelect = False
  .Title = "Select a file for content replication"
  'Show the file path and file name
  If .Show = -1 Then
    MsgBox "You have selected: " & .SelectedItems(1)
    Set DocSrc = Documents.Open(.SelectedItems(1), ReadOnly:=True, Visible:=False)
  Else: Exit Sub
  End If
End With
Set DocTgt = ActiveDocument
' Starts extracting from source document
For i = 1 To ((DocSrc.Count) - 1)
  Set RngTgt = DocTgt.Sections(i).Range
  RngTgt.End = RngTgt.End - 1
  Set RngSrc = DocSrc.Sections(i).Range
  RngSrc.End = RngSrc.End - 1
  RngTgt.FormattedText = RngSrc.FormattedText
Next i
DocSrc.Close False
End Sub

这篇关于将文档中的某些内容复制到特定部分的其他内容的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！