PDA

View Full Version : MsgBox listing all sections that only carry a heading level 1



ahermle
10-07-2008, 12:41 PM
Dear Experts:

Below macro searches for sections that only have built-in heading level 1 and no subsequent lower heading levels and sets a specific header for them. It is running fine.
I wonder whether it is possible to expand the macro to show those sections (only featuring heading 1 and no other subsequent lower heading levels) in a MsgBox, such as:
Section 5, Summary
Section 6, Bibliography

The MsgBox should pop up in the place specified below.
Help is much appreciated. Thank you very much in advance.

Kind Regards, Andreas

Sub SetHeaderSectionsHeading1()
Dim s As Integer
Dim sect As Section
Dim HasHeading1() As Boolean
Dim HasHeading2() As Boolean
ReDim HasHeading1(ActiveDocument.Sections.count)
ReDim HasHeading2(ActiveDocument.Sections.count)
Dim rng As range

If MsgBox("This macro sets a specific header for all sections featuring just heading level 1" & vbCrLf & _
" .... Would you like to continue?", vbYesNo + vbQuestion, "Header for sections with just heading 1") = vbNo Then
Exit Sub
End If

Set rng = ActiveDocument.range
With rng.Find
.Format = True
.Style = ActiveDocument.Styles(wdStyleHeading1)
Do While .Execute(Wrap:=wdFindStop)
HasHeading1(rng.Sections(1).Index) = True
Loop
End With

Set rng = ActiveDocument.range
With rng.Find
.Format = True
.Style = ActiveDocument.Styles(wdStyleHeading2)
Do While .Execute(Wrap:=wdFindStop)
HasHeading2(rng.Sections(1).Index) = True
Loop
End With


For s = 1 To ActiveDocument.Sections.count
Set sect = ActiveDocument.Sections(s)
If HasHeading1(s) And Not HasHeading2(s) Then

<MsgBox listing these sections should go in here>

Set rng = sect.Headers(wdHeaderFooterPrimary).range

'Do processing page headers

End If

Next s

End Sub