删除Word VBA的最后一部分,而不会覆盖前一个标题

时间:2019-02-19 04:28:28

标签: vba ms-word word-vba

我在搜索该问题时发现了以下代码。这段代码的问题在于,它会将倒数第二节的标头(和页脚,尽管我只需要保留标头)覆盖为最后一节的标头,这是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代码中解决的方法。可以找到复杂的手动过程来避免这种情况,但是我需要一种简单的代码方法。

4 个答案:

答案 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文档的最后部分并不是一件容易的事。

如果文档的“倒数第二个”和“最后一个”部分之间的项目不同,则可能要做的事情。

  1. 确保在最后一节中,页眉或页脚中的所有“ linktoprevious”均设置为false

  2. 将倒数第二部分的所有页眉和页脚复制到末尾

  3. 将最后一节旁边的相关页面格式项复制到最后一节(纸张尺寸,方向,边距等)

  4. 获取文档最后一节的范围。向后移动范围的末端,直到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