Count of different word styles as csv file

vinod Kumar
vinod Kumar used Ask the Experts™
on
I need count of different word styles in the word document as a CSV file with column headers Style name and Styles Count.

My VB code for output as a popup for particular style in the word document.

   
Sub Count()
    Dim l As Long
    ResetSearch
    With ActiveDocument.Range.Find
       .Style = "Strong" 'Replace with the name of the style you are counting
       While .Execute
          l = l + 1
          If l > ActiveDocument.Range.Paragraphs.Count Then
             Stop
          End If
       Wend
    End With
    MsgBox l
    ResetSearch
    End Sub
    
    Public Sub ResetSearch()
    With Selection.Find
       .ClearFormatting
       .Replacement.ClearFormatting
       .Text = ""
       .Replacement.Text = ""
       .Forward = True
       .Wrap = wdFindContinue
       .Format = False
       .MatchCase = False
       .MatchWholeWord = False
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
       ' plus some more if needed
       .Execute
    End With
    End Sub

Open in new window


Please suggest that different styles in word not only strong any type of style count in csv format column headers are Style name and Styles Count
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
GrahamSkanRetired
Top Expert 2012

Commented:
Creating a well-formed CSV file to cater for all possibilities of data is quite complex and it's not built in to Word. This macro will make a table in a new word document. If you definitely need a CSV, it will need to be adapted. Or if you have you have Excel or Access, you could copy and paste the table into one of those and Save (Excel) or Export(Access) to CSV.

Sub CountParagraphStyles()
    Dim sty As Word.Style
    Dim tbl As Word.Table
    Dim doc As Word.Document
    Dim docA As Word.Document
    Dim para As Word.Paragraph
    Dim bMissing As Boolean
    Dim rw As Word.Row
    
    
    Set docA = ActiveDocument
    Set doc = Documents.Add
    
    Set tbl = doc.Tables.Add(doc.Range, 1, 2)
    tbl.Cell(1, 1).Range.Text = "Style"
    tbl.Cell(1, 2).Range.Text = "Count"
    For Each para In docA.Range.Paragraphs
        bMissing = True
        For Each rw In tbl.Rows
            If GetCellText(rw.Cells(1)) = para.Style Then
                rw.Cells(2).Range.Text = Val(rw.Cells(1).Range.Text) + 1
                bMissing = False
                Exit For
            End If
        Next rw
        If bMissing Then
            Set rw = tbl.Rows.Add
            rw.Cells(1).Range.Text = para.Style
            rw.Cells(2).Range.Text = 1
        End If
    Next para
End Sub

Open in new window

vinod KumarContent Engineer

Author

Commented:
For the above code i am getting the error which was shown in attached image
GrahamSkanRetired
Top Expert 2012

Commented:
Sorry, you forgot to attach the image.

Actually the text of the message would be better, because search engines can then find it again. Also it would help to know which line of code it is failing on.
OWASP: Avoiding Hacker Tricks

Learn to build secure applications from the mindset of the hacker and avoid being exploited.

Interesting requirement; I can see some use for this too!

The error the OP sees is probably "Compile error: Sub or Function not defined" related to the call at line 20 (GetCellText(rw.Cells(1)) ).
GrahamSkanRetired
Top Expert 2012

Commented:
Thanks, Eric. Well spotted.
I forgot to post my little function:
Function GetCellText(cl As Cell) As String
    Dim rng As Range
    
    Set rng = cl.Range
    rng.MoveEnd wdCharacter, -1
    GetCellText = rng.Text
End Function

Open in new window

The tool is no use at all without it
Thanks Graham; that stops the error of course!

However, the resulting table only shows a count of 1 for each style listed. Perhaps like the OP, I was hoping to see a solution for my quest to obtain a count of the number of times each style is used within a document.

In the document I used to test your routine, using the "Find In" option of Word's Find dialog to select all instances of the style "Body Text First Indent" reports that my main document has 151 instances. The "select all" option of the Styles dialog for that style matches this count. Being able to see these counts can be very helpful for cleaning up unnecessary styles from documents — but I have been unable to find where (or if) the count result is enumerated somewhere within Word.

A 2010-era bookmarked discussion about verifying whether a style is being used (here includes VBA for creating a table of styles in use, but it has no hint as to how to get a count of the times used.

I suppose I could use a brute force method to count the number of times each instance was found (While Find.Found?), but I'm reluctant to use that approach if there is already a counter being maintained somewhere.
vinod KumarContent Engineer

Author

Commented:
Hi @GrahamSkan your answer was some what near i am getting count of styles 1 only for all styles
GrahamSkanRetired
Top Expert 2012

Commented:
The macro went untested after a last-minute edit. Line 21 was wrong, adding from the wrong column.

Sub CountParagraphStyles()
    Dim sty As Word.Style
    Dim tbl As Word.Table
    Dim doc As Word.Document
    Dim docA As Word.Document
    Dim para As Word.Paragraph
    Dim bMissing As Boolean
    Dim rw As Word.Row
    
    
    Set docA = ActiveDocument
    Set doc = Documents.Add
    
    Set tbl = doc.Tables.Add(doc.Range, 1, 2)
    tbl.Cell(1, 1).Range.Text = "Style"
    tbl.Cell(1, 2).Range.Text = "Count"
    For Each para In docA.Range.Paragraphs
        bMissing = True
        For Each rw In tbl.Rows
            If GetCellText(rw.Cells(1)) = para.Style Then
                rw.Cells(2).Range.Text = Val(rw.Cells(2).Range.Text) + 1
                bMissing = False
                Exit For
            End If
        Next rw
        If bMissing Then
            Set rw = tbl.Rows.Add
            rw.Cells(1).Range.Text = para.Style
            rw.Cells(2).Range.Text = 1
        End If
    Next para
End Sub

Function GetCellText(cl As Cell) As String
    Dim rng As Range
    
    Set rng = cl.Range
    rng.MoveEnd wdCharacter, -1
    GetCellText = rng.Text
End Function

Open in new window

vinod KumarContent Engineer

Author

Commented:
Hi @GrahamSkan,
Is it possible to export the report as CSV file.
Using the above code i am getting the only paragraph styles count only, I am not getting the character styles.
Please suggest.
GrahamSkanRetired
Top Expert 2012

Commented:
Not many people use character styles. Mainly they just apply font formatting directly. This macro does the same sort of thing that the paragraph style macro does except that it steps through the document character by character.This makes it very slow. If you still think you have a use for it, I might be able to speed it up using the Find object.

As I said before, it would be best to use Access or Excel to produce a CSV file. Do you have one or both?
vinod KumarContent Engineer

Author

Commented:
Hi @GrahamSkan,

Yes, We need character styles also, I am using excel. Please suggest to produce styles names and their count in a CSV file, Instead of separate word file.

Thanks,
Vinod
Retired
Top Expert 2012
Commented:
Sorry for the delay. I had a hard-to-spot logic error in the code:
Sub CountStylesToCSV()
    Dim xlApp As Excel.Application
    Dim xlWbk As Excel.Workbook
    Dim xlWks As Excel.Worksheet
    
    Dim Sty As Word.Style
    Dim docA As Word.Document
    Dim para As Word.Paragraph
    Dim Rng As Word.Range
    
    Dim strStyleType As String
    Dim strNameParts() As String
    Dim bMissing As Boolean
    Dim r As Integer
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlWbk = xlApp.Workbooks.Add
    Set xlWks = xlWbk.Worksheets.Add
    xlApp.Visible = True
   
    Set docA = ActiveDocument
    xlWks.Cells(1, 1).Value = "Style"
    xlWks.Cells(1, 2).Value = "Count"
    xlWks.Cells(1, 3).Value = "Type"
    'Debug.Print "Document Style count: ", docA.Styles.Count
    For Each Sty In docA.Styles
        Select Case Sty.Type
            Case wdStyleTypeCharacter
                strStyleType = "Character"
            Case wdStyleTypeLinked:
                strStyleType = "Linked"
            Case wdStyleTypeList:
                strStyleType = "List"
            Case wdStyleTypeParagraph
                strStyleType = "Paragraph"
            Case wdStyleTypeParagraphOnly:
                strStyleType = "ParagraphOnly"
            Case wdStyleTypeTable:
                strStyleType = "Table"
            Case Else
                strStyleType = "Unknown"
        End Select
        'Debug.Print "Listed: ", strStyleType, Sty.NameLocal
        If Sty.Type = wdStyleTypeCharacter Or Sty.Type = wdStyleTypeParagraph Then
            'Debug.Print "Seeking: ", strStyleType, Sty.NameLocal
            Set Rng = docA.Range
            With Rng.Find
                .Style = Sty.NameLocal
                Do While .Execute()
                    DoEvents
                    bMissing = True
                    r = 2
                    Do Until xlWks.Cells(r, 1).Value = ""
                        If xlWks.Cells(r, 1).Value = Sty.NameLocal Then
                            xlWks.Cells(r, 2).Value = Val(xlWks.Cells(r, 2).Value) + 1
                            bMissing = False
                            Exit Do
                        End If
                        r = r + 1
                    Loop
                    If bMissing Then
                        xlWks.Cells(r, 1).Value = Sty.NameLocal
                        xlWks.Cells(r, 2).Value = 1
                        xlWks.Cells(r, 3).Value = strStyleType
                    End If
                Loop
                Rng.Start = Rng.End
                Rng.End = docA.Range.End
            End With
        End If
    Next Sty
    strNameParts = Split(docA.FullName, ".")
    strNameParts(UBound(strNameParts)) = "_styles.csv"
    xlWbk.SaveAs Join(strNameParts()), xlCSV
    xlWbk.Close
    xlApp.Quit
End Sub

Open in new window

FYI, the error was in line 57. The  text read "Exit For" instead of "Exit Do". This made the macro miss out some styles.
vinod KumarContent Engineer

Author

Commented:
By running macro i am getting the error as shown in the attached file.  Image of the Error message
GrahamSkanRetired
Top Expert 2012

Commented:
I am sorry for not telling you. The Excel code uses early binding, which requires a reference to the Microsoft Excel Object Library. This is set in the VBA editor, via the Tools menu, References item. Make sure that the item is ticked
vinod KumarContent Engineer

Author

Commented:
Thank you, great, GrahamSkan, Your code is working fine.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial