Running headers for multiple levels of headings

Question

I know, there is a simple way to create running headers using STYLEREF field. Just put this:

{ STYLEREF "Heading 1" }

in the header of your document, and it works fine.

However, the problem arises when I want to match multiple heading levels. For example, on 1st page of my document I have a Heading 1 style with text Foo. And on the 2nd page of document I have Heading 2 style with text Bar.

When I'm on 1st page of document, I want to see the "Foo" in the page header. When I'm on the 2nd page, I want to see "Bar" in the page header.

It is very simple in LibreOffice, but I haven't find any "proper" way to achieve it in MS Word.

Sidenote: Well, there exists a workaround: create a character style "My headings" and apply it on the paragraph styles "Heading 1" and "Heading 2", and then use it in STYLEREF field:

{ STYLEREF "My headings" }

But it is not convenient.

I post it as StackOverflow question, because I believe, this probably could be fixed with macro.

Answer 1

I checked again and tried to write a macro. The macro would be possible but the difficulties starts when it comes to insert the current header style text into the page header. Since in Microsoft Word the page headers display always the same content on every page, you would need to introduce Section break on every single page. This would then allow you to have different page header content on every page. Also it's necessary to ensure that the header option connect with previous is unticked so this would work at all.

Given that it would be possible to insert the style header text of each page into the page headers of each page. It would be a really "hacky" solution and your document would be full of sections due to the section breaks. I wouldn't want to work with such a document though but that's up to you.

Here is the NOT WORKING macro I've came up with until I realized the section issue:

Sub RunningHeader()
' THIS MACRO DOES NOT WORK!

' Date: 2017.08.08
' Running header macro
' Assumes every page ends with a section break
' Supports to set running header up to level 3

Dim mPageCount As Integer
Dim mCurrentPage As Integer
Dim mPageRange As Range
Dim mSection As Section

Dim mRunningHeader As String

mPageCount = ActiveDocument.ComputeStatistics(wdStatisticPages)

' ToDo
' Ensure each page of the document ends with a "section break"

' Loop through each page.
' Idea looping through pages from:
' https://support.microsoft.com/en-us/help/269565/how-to-automate-word-to-set-and-retrieve-section-header-and-footer-inf
For mCurrentPage = 1 To mPageCount
    '
    If intpage <> 1 Then
        ' Goes to the top of the next page.
        Selection.GoToNext What:=wdGoToPage
    Else
        ' Goes to the top of the first page.
        Selection.HomeKey Unit:=wdStory
    End If

    ' Selects the content of the current page
    ActiveDocument.Bookmarks("\page").Range.Select

    ' Get text of highest header style on current page
    mRunningHeader = GetHighestHeader

    ' Get section of current page
    Set mPageRange = ActiveDocument.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=mCurrentPage)
    Set mSection = mPageRange.Sections(1)

    ' Disconnect page header from previous
    ' ToDo

    ' Set text into page header
    ' ToDo
Next

End Sub

Private Function GetHighestHeader() As String
    Dim mParagraph As Paragraph
    Dim mHighestHeaderText As String
    Dim mHighestHeaderNumber As Integer

    mHighestHeaderText = ""

    For Each mParagraph In Selection.Paragraphs
        If mParagraph.Style = ActiveDocument.Styles(wdStyleHeading1) Then
            mHighestHeaderText = mParagraph.Range.Text
            Exit For
        End If
        If mParagraph.Style = ActiveDocument.Styles(wdStyleHeading2) Then
            If mHighestHeaderNumber < 2 Then
                mHighestHeaderText = mParagraph.Range.Text
                mHighestHeaderNumber = 2
            End If
        End If
        If mParagraph.Style = ActiveDocument.Styles(wdStyleHeading3) Then
            If mHighestHeaderNumber < 3 Then
                mHighestHeaderText = mParagraph.Range.Text
                mHighestHeaderNumber = 3
            End If
        End If
    Next mParagraph

    GetHighestHeader = mHighestHeaderText
End Function