none
Count number of sub headings under a heading RRS feed

  • Question

  • Hi,

    I've got a document structured as follows:

    1. Heading 1
    2. Heading 2
      2.1 Subheading 1
      2.2 Subheading 2
      2.3 Subheading 3
      2.4 Subheading 4
    3
      3.1 Subheading 1
      3.2 Subheading 2
    4. Heading 4

    I want to create a document property that tells me how many sub headings there are under a heading. In the case above the number should be 0 for 1, 4 for 2, 2 for 3 and 0 for 4 again.

    I'd love to be able to do this without macro or VBA involvement, but I don't think that is possible.

    Any help will be much appreciated.


    Good luck,

    Michel Verhagen, eMVP
    Check out my blog: http://guruce.com/blog

    GuruCE
    Microsoft Embedded Partner
    http://guruce.com
    Consultancy, training and development services.

    Monday, June 10, 2013 1:22 AM

Answers

  • Hi Michel:

    You are quite correct, this cannot be done any way except VBA.

    Even doing it in VBA is quite a lot of coding.  You have to iterate every paragraph in the document and return the "Level" property of the ListFormat object.

    Load the levels into an Array, parse the array: every time you see the level fall to a lesser number you have found a parent: count the number of paragraphs at that level until you next see a change in level.

    This is a lot of work to get it right, because in a typical office document there will be multiple non-heading paragraphs interspersed with the headings, and the heading paragraphs do not necessarily have a level: typically unskilled users will create headings out of styles that do not have a level property assigned, or add list formatting to non-styled or wrong-styled paragraphs.

    I am not sure what your use case is, but have a look at the Outline View in Word.  No coding involved and you can determine how many subheadings you have by inspection in a single glance.  Sadly, you can't retrieve that information programatically.

    Hope this helps


    -- John McGhie, Microsoft MVP (Word, Mac Word), Consultant Technical Writer, McGhie Information Engineering Pty Ltd Sydney, Australia. | Ph: +61 (0)4 1209 1410 +61 4 1209 1410, mailto:john@mcghie.name

    Monday, June 10, 2013 2:02 AM

All replies

  • Hi Michel:

    You are quite correct, this cannot be done any way except VBA.

    Even doing it in VBA is quite a lot of coding.  You have to iterate every paragraph in the document and return the "Level" property of the ListFormat object.

    Load the levels into an Array, parse the array: every time you see the level fall to a lesser number you have found a parent: count the number of paragraphs at that level until you next see a change in level.

    This is a lot of work to get it right, because in a typical office document there will be multiple non-heading paragraphs interspersed with the headings, and the heading paragraphs do not necessarily have a level: typically unskilled users will create headings out of styles that do not have a level property assigned, or add list formatting to non-styled or wrong-styled paragraphs.

    I am not sure what your use case is, but have a look at the Outline View in Word.  No coding involved and you can determine how many subheadings you have by inspection in a single glance.  Sadly, you can't retrieve that information programatically.

    Hope this helps


    -- John McGhie, Microsoft MVP (Word, Mac Word), Consultant Technical Writer, McGhie Information Engineering Pty Ltd Sydney, Australia. | Ph: +61 (0)4 1209 1410 +61 4 1209 1410, mailto:john@mcghie.name

    Monday, June 10, 2013 2:02 AM
  • Thanks John,

    I started the work but it got quite complex quite quick so I thought that was because I was missing something obvious. I'm not that familiar with the Word document objects, but it's good to know it's not me being stupid.

    Oh well, I may continue with the code or I just have to remember to update that reference everytime I add a sub heading...

    Thanks!


    Good luck,

    Michel Verhagen, eMVP
    Check out my blog: http://guruce.com/blog

    GuruCE
    Microsoft Embedded Partner
    http://guruce.com
    Consultancy, training and development services.

    Monday, June 10, 2013 2:12 AM
  • FWIW - Here is code that scans for Outline Levels properly associated with Paragraph Styles in a document. If the first Outline level is not level 1, it captures and reports it.

    Sub CountSubHeadings()
        Dim doc As Word.Document
        Dim rng As Word.Range
        Dim sty As Word.Style
        Dim bmk As Word.Bookmark
        Dim LvlArray(9) As String
        Dim LvlNbr As Integer
        
        On Error GoTo errRoutine
        Set doc = ActiveDocument
        For Each sty In doc.Styles
            If sty.InUse Then
                If sty.Type = wdStyleTypeParagraph Or sty.Type = wdStyleTypeParagraphOnly Then
                    If sty.ParagraphFormat.OutlineLevel <> wdOutlineLevelBodyText Then
                        LvlNbr = sty.ParagraphFormat.OutlineLevel
                        If Len(LvlArray(LvlNbr)) > 1 Then LvlArray(LvlNbr) = LvlArray(LvlNbr) & ","
                        LvlArray(LvlNbr) = LvlArray(LvlNbr) & sty.NameLocal
                    End If
                End If
            End If
        Next
        
        deleteBmks doc, "zBmk"
        Dim BmkIndex As Integer
        BmkIndex = doc.Bookmarks.Count
        
        Dim styName As Variant
        Dim i As Integer
        For LvlNbr = 1 To 9
            styName = Split(LvlArray(LvlNbr), ",")
            For i = LBound(styName) To UBound(styName)
                SetBookmarks doc, rng, styName(i), LvlNbr
            Next
        Next
        
        Dim firstTime As Boolean
        Dim HdrCount As Integer
        Dim SubCount As Integer
        Dim LvlName As String
        
        firstTime = True
        
        For Each bmk In doc.Bookmarks
            If Left(bmk.Name, 4) = "zBmk" Then
                If firstTime Then
                    LvlName = Right(bmk.Name, 5)
                    HdrCount = 1
                    SubCount = 0
                    firstTime = False
                Else
                    If Right(bmk.Name, 1) = 1 Then
                        Debug.Print HdrCount; "- "; LvlName; " Subheadings:"; SubCount
                        LvlName = Right(bmk.Name, 5)
                        HdrCount = HdrCount + 1
                        SubCount = 0
                    Else
                        SubCount = SubCount + 1
                    End If
                End If
            End If
        Next
        If LvlName <> "" Then Debug.Print HdrCount; "- "; LvlName; " Subheadings:"; SubCount
        
       
        deleteBmks doc, "zBmk"
        Exit Sub
        
    errRoutine:
        MsgBox "CountSubHeadings Error:" & vbCr & Err.Description, vbCritical
        deleteBmks ActiveDocument, "zBmk"
        
    End Sub
    
    Private Sub SetBookmarks(doc As Word.Document, rng As Word.Range, styName As Variant, LvlNbr As Integer)
        Dim nFormat, bmkName As String
        
        Set rng = doc.Range
        On Error GoTo errRoutine
        With rng.Find
            .ClearFormatting
            .Text = ""
            .Style = doc.Styles(styName).NameLocal
            .Replacement.Text = ""
            .Forward = True
            .Format = True
            .Wrap = wdFindStop
            .Execute
            Do Until Not .Found
                nFormat = Format(rng.Start, "000000000000")
                bmkName = "zBmk" & nFormat & "Lvl_" & LvlNbr
                doc.Bookmarks.Add bmkName, rng
                rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
                .Execute
            Loop
        End With
    
        Exit Sub
    
    errRoutine:
        MsgBox "SetBookmarks Error:" & vbCr & Err.Description, vbCritical
        deleteBmks ActiveDocument, "zBmk"
        
    End Sub
    
    Private Sub deleteBmks(doc As Word.Document, bmkName As String)
        Dim i As Integer
        For i = doc.Bookmarks.Count To 1 Step -1
            If Left(doc.Bookmarks(i).Name, 4) = bmkName Then
                doc.Bookmarks(i).Delete
            End If
        Next
    End Sub
    


    Kind Regards, Rich ... http://greatcirclelearning.com

    Monday, June 10, 2013 4:44 PM