Question

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

问题在于，当我复制源部分时，该复制命令还包括源doc中的分节符。因此，当我将其粘贴到目标文档时，它会吹走目标部分的中断字符（如果该目标部分是文档中的最后一部分，则添加新部分，因此没有分节符字符跟着它。）

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

您的代码存在的问题是您不会复制移动结束的内容。更改选择不会影响范围。

它更适合直接使用Range对象而不是Selection。 MoveEnd方法应该适用于此。试试这样的事情

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

Answer 2

谢谢辛迪！你的建议让我到了我需要的地方。您的代码需要稍微调整一下。你把它作为一个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 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

将一个部分的内容复制到另一部分，而不会打扰分节？

3 个答案: