将一个部分的内容复制到另一个部分,而不干扰分节符?
copy contents of a section to another section, without disturbing section breaks?
我有一个源和目标 Word 2013 文档。每个文档都有多个分节符,每个部分都有非常特殊的页脚,我不能打扰。我只需要从源文档中复制特定部分的 contents(不带分节符),并将这些内容粘贴到目标文档的特定部分 - 例如将源第 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
选择中的这些减少减少了部分的实际文本,但似乎没有排除分节符,我认为它在选择范围内?
你的代码的问题是你没有复制你移动结束的地方。更改选择不会影响范围。
直接使用 Range 对象比使用 Selection 更好。 MoveEnd 方法应该适用于此。尝试这样的事情
Dim rngSec as Word.Range
Set rngSec = source.Sections(3).Range
rngSec.MoveEnd wdCharacter, -1
rngSec.Copy
谢谢辛迪!你的建议让我到达了我需要去的地方。您的代码需要稍微调整一下。您将 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
我在整个 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
我有一个源和目标 Word 2013 文档。每个文档都有多个分节符,每个部分都有非常特殊的页脚,我不能打扰。我只需要从源文档中复制特定部分的 contents(不带分节符),并将这些内容粘贴到目标文档的特定部分 - 例如将源第 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
选择中的这些减少减少了部分的实际文本,但似乎没有排除分节符,我认为它在选择范围内?
你的代码的问题是你没有复制你移动结束的地方。更改选择不会影响范围。
直接使用 Range 对象比使用 Selection 更好。 MoveEnd 方法应该适用于此。尝试这样的事情
Dim rngSec as Word.Range
Set rngSec = source.Sections(3).Range
rngSec.MoveEnd wdCharacter, -1
rngSec.Copy
谢谢辛迪!你的建议让我到达了我需要去的地方。您的代码需要稍微调整一下。您将 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
我在整个 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