将一节的内容复制到另一节，而不会干扰分节

Question

我有一个源和一个目标Word 2013文档。每个文档都有多个分节符，每个分节符中都有非常特殊的页脚，我不能打扰。我只需要从源文档复制某个部分的内容（没有分节符），并将这些内容粘贴到目标文档的某个部分，例如将源部分3的文本复制到目标部分5。

问题是，当我复制源节时，复制命令还包括源文档中的分节符。因此，当我将其粘贴到目标文档中时，它要么会吹掉目标节的换行符（如果目标节是文档中的最后一个，则会添加一个新节，因此后面没有分节符）。

Word中有没有一种方法，使用VBA宏，只复制源文档中给定节的原始内容，而不复制该节的分节符，并将其粘贴到另一个文档中，而不破坏目标节的分节符号？

我试过各种各样的变体，比如

source.Sections(3).Range.Select
source.Sections(3).Range.Copy
dest.Sections(5).Range.Select
dest.Sections(5).Range.Paste

但是粘贴行会干扰目标文档的分节符。我还尝试将源文档的选择长度（在复制之前）减少一个字符，希望排除分节符：

source.Sections(3).Range.Select
source.ActiveWindow.Selection.MoveEnd Unit:=wdCharacter, Count:= -1  ' (I also tried -2, -3, etc)
source.Sections(3).Range.Copy
dest.Sections(5).Range.Select
dest.ActiveWindow.Selection.MoveEnd Unit:=wdCharacter, Count:= -1  ' (I also tried -2, -3, etc)
dest.Sections(5).Range.Paste

选择中的这些减少减少了部分的实际文本，但似乎不排除分节符，我认为它在选择范围内？

Answer 1

谢谢Cindy！你的建议把我带到了我需要的地方。你的代码需要一点调整。你把rngSec调暗为Word。Section，但它抱怨；我想你是指Word。Range，不是吗？在没有进行rng.select的情况下，复制行抱怨没有选择文本。

以下代码用于从一个文档中获取节的内容，并将它们按相反的顺序放在另一个文档上，而不影响任何分节符：

Option Explicit
Sub switch_sections()
Dim SourceDoc As Document, DestDoc As Document
Dim i As Integer
Dim has_section_break As Boolean
Set SourceDoc = Application.Documents("source.docx")
Set DestDoc = Application.Documents("destination.docx")
Dim SrcRng As Range    ' Word.Section
Dim DestRng As Range    ' Word.Section
For i = 1 To SourceDoc.Sections.Count
    With SourceDoc.Sections(i).Range.Find
        ' Check for a section break.  Put this find first, else it
        ' screws up the selection we will do below.
        .Text = "^b"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .Execute
        If .Found Then
            has_section_break = True
        End If
    End With
    Set SrcRng = SourceDoc.Sections(i).Range
    SrcRng.Select
    If has_section_break Then SrcRng.MoveEnd wdCharacter, -1
    SrcRng.Copy     ' Copy all but section break
    With DestDoc.Sections(DestDoc.Sections.Count - (i - 1)).Range.Find
        ' Check for a section break.  Put this find first, else it
        ' screws up the selection we will do below.
        .Text = "^b"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .Execute
        If .Found Then
           has_section_break = True
        End If
    End With
    Set DestRng = DestDoc.Sections(DestDoc.Sections.Count - (i - 1)).Range
    DestRng.Select
    If has_section_break Then DestRng.MoveEnd wdCharacter, -1
    DestRng.Paste   ' Replace all but the section break
   Next
 End Sub

Answer 2

您的代码的问题是，您没有复制移动末端的东西。更改"选择"不会影响"范围"。

与其使用"选择"，不如直接使用"范围"对象。MoveEnd方法应该与之配合使用。试试这个

Dim rngSec as Word.Range
Set rngSec = source.Sections(3).Range
rngSec.MoveEnd wdCharacter, -1
rngSec.Copy

Answer 3

我浏览了整个互联网，并重新编写了代码，使其能够满足我的需要。这只是将一个文档复制到另一个文档，并且不会删除任何现有的页眉和页脚。您可以将其转移到现有代码中，或者创建一个单独的子程序，但可能需要传递一些变量。

Dim oSec As Section
    Dim oHead As HeaderFooter
    Dim oFoot As HeaderFooter
    Selection.HomeKey Unit:=wdStory
    For Each oSec In ActiveDocument.Sections
        For Each oHead In oSec.Headers
            If oHead.Exists Then oHead.Range.Delete
        Next oHead
    For Each oFoot In oSec.Footers
        If oFoot.Exists Then oFoot.Range.Delete
    Next oFoot
Next oSec
' Now remove all section breaks - This is key
With Selection.Find
.Text = "^b"
.Replacement.Text = ""
.Forward = True
.Wrap = False
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.WholeStory
Selection.Copy ' Copy the entire document
HoldingFileName.Activate
Selection.EndKey Unit:=wdStory
Selection.InsertBreak Type:=wdPageBreak
DoEvents
         
Selection.Paste
DoEvents
' Unselect from source
HoldingFileName.Activate
DoEvents
ActiveDocument.Range(0, 0).Select
ActiveDocument.Save