Running headers for multiple levels of headings - vba

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