我在搜索该问题时发现了以下代码。这段代码的问题在于,它会将倒数第二节的标头(和页脚,尽管我只需要保留标头)覆盖为最后一节的标头,这是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代码中解决的方法。可以找到复杂的手动过程来避免这种情况,但是我需要一种简单的代码方法。
答案 0 :(得分:2)
这里的问题在于分节符中包含节信息。如果删除它,最后一部分将成为之前部分的一部分。我在下面使用的技巧是创建一个连续的分节符而不是一个分页符,然后执行所有其余操作:
Sub DeleteLastSection()
'Deletes last section of a document including
'the section break
Dim doc As Document
Dim rng As Range
Dim NewEndOfDocument As Range
Dim ctr As Integer
Set doc = ActiveDocument
ctr = doc.Sections.Count
Set rng = doc.Sections(ctr).Range
If ctr > 1 Then
' Create a section break at the end of the second to last section
Set NewEndOfDocument = doc.Sections(ctr - 1).Range
NewEndOfDocument.EndOf wdSection, wdMove
doc.Sections.Add NewEndOfDocument, wdSectionContinuous
With rng
.Select
.MoveStart Unit:=wdCharacter, Count:=-1
.Delete
End With
End If
End Sub
答案 1 :(得分:1)
通常,删除分节符会导致分节符之前的节采用下节的页面布局。下面的宏以另一种方式工作,跨越多个(选定的)分节符。解决了所有常见的页面布局问题(页边距,页面方向,文本列,页眉和页脚)。正如您通过学习代码所看到的那样,做所有这些事情并不是一件容易的事。
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
答案 2 :(得分:0)
删除Word文档的最后部分并不是一件容易的事。
如果文档的“倒数第二个”和“最后一个”部分之间的项目不同,则可能要做的事情。
确保在最后一节中,页眉或页脚中的所有“ linktoprevious”均设置为false
将倒数第二部分的所有页眉和页脚复制到末尾
将最后一节旁边的相关页面格式项复制到最后一节(纸张尺寸,方向,边距等)
获取文档最后一节的范围。向后移动范围的末端,直到ascii值> = 32。
然后,您可以安全地从文档中删除调整后的范围,而不会产生任何令人讨厌的副作用
答案 3 :(得分:0)
我自己进行了更多研究(我不得不在短时间内解决问题,迫不及待),得出的结论与@CindyMeister的评论中提到的结论相同,即删除最后一个“分节符”时实际上,倒数第二个部分已被删除,并且迄今为止,属于最后一个部分的数据和格式显然是 new 的最后一个部分(即较早的倒数第二节)。但实际上,最后一部分仍然保留,只有分节符被删除,因此删除的是倒数第二个部分(以及最后一部分的实际页面)。
我发现LinkToPrevious
对象的HeaderFooter
属性允许采用一种简单的方法来“继承”上一部分中的设置。
因此,通过添加几行以在每个实例中将此属性设置为true
,然后将其更改回false
,我可以得到倒数第二个部分所需的行为,即和之前一样。
((请注意,它对我有用,因为我在主标题中只是具有不同的文本,并且没有特殊的格式等)。但是我怀疑根据LinkToPrevious
属性的工作原理,这是一个灵丹妙药。否则请发表评论。)
以下是用于设置属性的行:
for each hf in .Sections(1).Headers
hf.LinkToPrevious = True
hf.LinkToPrevious = False
next
for each hf in .Sections(1).Footers
hf.LinkToPrevious = True
hf.LinkToPrevious = False
next
后代的完整工作代码:
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
'Added lines to "inherit" the settings from the next-to-last section
for each hf in .Sections(1).Headers
hf.LinkToPrevious = True
hf.LinkToPrevious = False
next
for each hf in .Sections(1).Footers
hf.LinkToPrevious = True
hf.LinkToPrevious = False
next
.Select
.MoveStart Unit:=wdCharacter, Count:=-1
.Delete
End With
End If
End Sub