Удалить последний раздел в Word VBA без перезаписи предыдущего заголовка

Question

У меня есть следующий код, который я нашел, когда гуглил проблему.Проблема с этим кодом состоит в том, что он перезаписывает заголовок следующего за последним раздела (и нижний колонтитул, хотя мне нужен только сохраненный заголовок) на заголовок последнего раздела, что является стандартным (странным) поведением 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.Чтобы избежать этого, можно найти сложные ручные процедуры, но мне нужен был простой подход в коде.

Answer 1

Рассматривая это самостоятельно (мне пришлось решить проблему в короткие сроки и я не мог ждать), я пришел к тому же выводу, который был отмечен в комментарии @CindyMeister, что при удалении последнего «разрыва раздела»на самом деле, следующий за последним раздел удаляется, и то, какие данные и форматирование ранее принадлежали последнему разделу, является , по-видимому, , унаследованным новым последним разделом (т. е. более ранним следующимдо последнего раздела).Но в действительности последний раздел остался, и был удален только разрыв раздела, поэтому был удален следующий за последним раздел (и фактические страницы из последнего раздела).

Я обнаружил, что 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

Answer 2

Удаление последнего раздела текстового документа не является тривиальной задачей.

Вещи, которые вам, возможно, придется сделать, если элементы отличаются между разделами «рядом с последним» и «последним» документа.

1. Убедитесь, что в последнем разделе для любого 'linktoprevious' в верхнем или нижнем колонтитуле установлено значение false

2. Скопируйте все верхние и нижние колонтитулы изрядом с последним разделом в последний раздел

3. Скопируйте соответствующие элементы формата страницы следующего за последним разделом в последний раздел (размер бумаги, ориентация, поля и т. д.)

4. Получить диапазон для последнего раздела в документе.Перемещайте конец диапазона назад, пока значение ascii не станет равным> = 32.

Затем вы можете безопасно удалить скорректированный диапазон из документа без каких-либо неприятных побочных эффектов

Answer 3

Обычно удаление разрыва раздела приводит к тому, что раздел, предшествующий разрыву, принимает макет страницы следующего раздела.Следующий макрос работает по-другому, через несколько (выбранных) разрывов разделов.Все распространенные проблемы макета страницы (поля, ориентация страницы, текстовые столбцы, верхние и нижние колонтитулы) устранены.Как вы можете видеть, изучая код, нетрудно выполнить все эти вещи.

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

Answer 4

Проблема здесь заключается в том, что разрыв раздела несет информацию раздела.Если вы удалите его, последний раздел станет частью предыдущего раздела.Уловка, которую я использую ниже, состоит в том, чтобы создать непрерывный разрыв раздела вместо разрыва страницы, а затем сделать все остальное:

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