删除Word VBA中的最后一节而不覆盖前面的标题
删除Word VBA中的最后一节而不覆盖前面的标题
提问于 2019-02-19 04:28:27
在搜索这个问题时，我发现了下面的代码。这段代码的问题是，它将下一节的页眉(以及页脚，尽管我只需要保留页眉)覆盖到最后一节的页眉，这是Word的默认(奇怪)行为。
在VBA中有解决办法吗？
下面是具有固有错误的代码：
Sub DeleteLastSection()
'Deletes last section of a document including
'the section break
Dim doc As Document
Dim rng As Range
Dim ctr As Integer
Set doc = ActiveDocument
ctr = doc.Sections.Count
Set rng = doc.Sections(ctr).Range
Dim myheader As HeaderFooter
If ctr > 1 Then
With rng
.Select
.MoveStart Unit:=wdCharacter, Count:=-1
.Delete
End With
End If
End Sub注意：最后一节的整个范围都被代码删除了，这是必需的行为。Word默认行为中固有的问题是，我需要在VBA代码中找到解决办法。人们可以找到复杂的手动过程来避免它，但我需要一种简单的代码方法。
Stack Overflow用户
发布于 2019-02-19 22:17:34
通常，删除“区段中断”将导致中断之前的“区段”假定以下区段的页面布局。以下宏以另一种方式工作，跨越多个(选定的)区段中断。解决了所有常见的页面布局问题(页边距、页面方向、文本列、页眉和页脚)。正如您通过研究代码所看到的，做所有这些事情并不是一件简单的事情。
Sub MergeSections()
Application.ScreenUpdating = False
Dim sPageHght As Single, sPageWdth As Single
Dim sHeaderDist As Single, sFooterDist As Single
Dim sTMargin As Single, sBMargin As Single
Dim sLMargin As Single, sRMargin As Single
Dim sGutter As Single, sGutterPos As Single
Dim lPaperSize As Long, lGutterStyle As Long
Dim lMirrorMargins As Long, lVerticalAlignment As Long
Dim lScnStart As Long, lScnDir As Long
Dim lOddEvenHdFt As Long, lDiffFirstHdFt As Long
Dim bTwoPagesOnOne As Boolean, bBkFldPrnt As Boolean
Dim bBkFldPrnShts As Boolean, bBkFldRevPrnt As Boolean
Dim lOrientation As Long, oHdFt As HeaderFooter
Dim Sctn1 As Section, Sctn2 As Section
With Selection
If .Sections.Count = 1 Then
MsgBox "Selection does not span a Section break", vbExclamation
Exit Sub
End If
Set Sctn1 = .Sections.First: Set Sctn2 = .Sections.Last
With Sctn1.PageSetup
lPaperSize = .PaperSize
lGutterStyle = .GutterStyle
lOrientation = .Orientation
lMirrorMargins = .MirrorMargins
lScnStart = .SectionStart
lScnDir = .SectionDirection
lOddEvenHdFt = .OddAndEvenPagesHeaderFooter
lDiffFirstHdFt = .DifferentFirstPageHeaderFooter
lVerticalAlignment = .VerticalAlignment
sPageHght = .PageHeight
sPageWdth = .PageWidth
sTMargin = .TopMargin
sBMargin = .BottomMargin
sLMargin = .LeftMargin
sRMargin = .RightMargin
sGutter = .Gutter
sGutterPos = .GutterPos
sHeaderDist = .HeaderDistance
sFooterDist = .FooterDistance
bTwoPagesOnOne = .TwoPagesOnOne
bBkFldPrnt = .BookFoldPrinting
bBkFldPrnShts = .BookFoldPrintingSheets
bBkFldRevPrnt = .BookFoldRevPrinting
End With
With Sctn2.PageSetup
.GutterStyle = lGutterStyle
.MirrorMargins = lMirrorMargins
.SectionStart = lScnStart
.SectionDirection = lScnDir
.OddAndEvenPagesHeaderFooter = lOddEvenHdFt
.DifferentFirstPageHeaderFooter = lDiffFirstHdFt
.VerticalAlignment = lVerticalAlignment
.PageHeight = sPageHght
.PageWidth = sPageWdth
.TopMargin = sTMargin
.BottomMargin = sBMargin
.LeftMargin = sLMargin
.RightMargin = sRMargin
.Gutter = sGutter
.GutterPos = sGutterPos
.HeaderDistance = sHeaderDist
.FooterDistance = sFooterDist
.TwoPagesOnOne = bTwoPagesOnOne
.BookFoldPrinting = bBkFldPrnt
.BookFoldPrintingSheets = bBkFldPrnShts
.BookFoldRevPrinting = bBkFldRevPrnt
.PaperSize = lPaperSize
.Orientation = lOrientation
End With
With Sctn2
For Each oHdFt In .Footers
oHdFt.LinkToPrevious = Sctn1.Footers(oHdFt.Index).LinkToPrevious
If oHdFt.LinkToPrevious = False Then
Sctn1.Headers(oHdFt.Index).Range.Copy
oHdFt.Range.Paste
End If
Next
For Each oHdFt In .Headers
oHdFt.LinkToPrevious = Sctn1.Headers(oHdFt.Index).LinkToPrevious
If oHdFt.LinkToPrevious = False Then
Sctn1.Headers(oHdFt.Index).Range.Copy
oHdFt.Range.Paste
End If
Next
End With
While .Sections.Count > 1
.Sections.First.Range.Characters.Last.Delete
Wend
Set Sctn1 = Nothing: Set Sctn2 = Nothing
End With
Application.ScreenUpdating = True
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/54758858
复制相关文章
相似问题
腾讯云开发者
Copyright © 2013 - 2026 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有
深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 
粤公网安备44030502008569号
腾讯云计算（北京）有限责任公司 京ICP证150476号 | 京ICP备11018762号