1

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

问题是当我复制源部分时，该复制命令还包括源文档中的分节符。因此，当我将其粘贴到目标文档中时，它要么删除该 dest 节的断字符（或者如果该目标节是文档中的最后一个节，则添加一个新节，因此后面没有分节符）。

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

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

4

3 回答 3

2

谢谢辛迪！你的建议把我带到了我需要去的地方。您的代码需要稍作调整。您将 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
于 2015-12-01T22:03:59.350 回答
1

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

直接使用 Range 对象比使用 Selection 更好。MoveEnd 方法应该可以使用它。尝试这样的事情

Dim rngSec as Word.Range
Set rngSec = source.Sections(3).Range
rngSec.MoveEnd wdCharacter, -1
rngSec.Copy
于 2015-12-01T20:36:24.387 回答
0

我查看了整个 Internet，并重新编写了代码，以便它可以满足我的需要。这只是从一个文档复制到另一个文档，不会删除任何现有的页眉和页脚。您可以将其粘贴到现有代码中，或创建一个单独的子例程，但您可能必须传递一些变量。

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
于 2021-06-07T13:22:38.100 回答