Count of different word styles as csv file

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
vinod KumarContent EngineerAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

GrahamSkanRetiredCommented:
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

0
vinod KumarContent EngineerAuthor Commented:
For the above code i am getting the error which was shown in attached image
0
GrahamSkanRetiredCommented:
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.
0
Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

Eric FletcherCommented:
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)) ).
0
GrahamSkanRetiredCommented:
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
1
Eric FletcherCommented:
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.
0
vinod KumarContent EngineerAuthor Commented:
Hi @GrahamSkan your answer was some what near i am getting count of styles 1 only for all styles
0
GrahamSkanRetiredCommented:
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

2
vinod KumarContent EngineerAuthor 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.
0
GrahamSkanRetiredCommented:
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?
0
vinod KumarContent EngineerAuthor 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
0
GrahamSkanRetiredCommented:
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.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
vinod KumarContent EngineerAuthor Commented:
By running macro i am getting the error as shown in the attached file.  Image of the Error message
0
GrahamSkanRetiredCommented:
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
0
vinod KumarContent EngineerAuthor Commented:
Thank you, great, GrahamSkan, Your code is working fine.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.