Generate a list of only those styles actually used in a given docx

Chris Morton started it when he posted the following on the Word-PC list:
"Word 2013: How do I quickly generate a list of only those styles actually used in a given docx?"

---

Jessica Weissman replied:
2013 may be different, but it takes a macro to list all styles ACTUALLY USED in a document. Meaning all styles in which there is at least one paragraph with the style in the current version of the document.

Here's one. You have to add the scripting additions in references to use the dictionary construct. It is a bit obsessive about the Normal style, which fit my use case.
I don't guarantee that it works, as I haven't tested it in 2010 and definitely not in 2013.

---

Sub FindAllUsedStyles()
' another method for finding and counting all actually used styles in a doc

Dim sAllStyles() As String
Dim vStyles As Variant
Dim I As Long
Dim idx As Long
Dim cParas As Long
Dim cStyles As Long
Dim cUsedStyles As Long
Dim sPrevStyle As String
Dim para As Paragraph

Dim aStory As Word.Range
Dim styleDict As New Scripting.Dictionary
Dim getStorytype As String
Dim aStyle As Style
Dim aStyleName As String
Dim aKey As Long
Dim tempKey As Long
Dim myRange As Range
Dim normCount As Long
normCount = 0

' put styles from the entire doc including headers and footers into a dictionary and count occurrences

For Each aStory In ActiveDocument.StoryRanges
getStorytype = Choose(aStory.StoryType, "wdMainTextStory", "wdFootnotesStory", "wdEndnotesStory", "wdCommentsStory", "wdTextFrameStory", "wdEvenPagesHeaderStory", "wdPrimaryHeaderStory", "wdEvenPagesFooterStory", "wdPrimaryFooterStory", "wdFirstPageHeaderStory", "wdFirstPageFooterStory", "wdFootnoteSeparatorStory", "wdFootnoteContinuationSeparatorStory", "wdFootnoteContinuationNoticeStory", "wdEndnoteSeparatorStory", "wdEndnoteContinuationSeparatorStory", "wdEndnoteContinuationNoticeStory")


If ((Left(getStorytype, 9) <> "wdEndnote") And (Left(getStorytype, 10) <> "wdFootnote")) Then

For Each para In aStory.Paragraphs
Set aStyle = para.Style


aStyleName = aStyle.NameLocal
' stuff below prevents counting Normal style for those phantom end of row markers
If aStyleName = "Normal" Then
If Not IsParaEndOfRow(para) Then
If Not IsParaEndOfHeaderFooter(para) Then
normCount = normCount + 1
' MsgBox "Normal found in " & getStoryType & normCount
' comment the line above back in if you want the macro to stop on every instance of Normal
If styleDict.Exists(aStyleName) Then
tempKey = (styleDict.Item(aStyleName)) + 1
styleDict.Item(aStyleName) = tempKey
Else
styleDict.Add aStyleName, 1
End If
End If
End If
Else
If styleDict.Exists(aStyleName) Then
tempKey = (styleDict.Item(aStyleName)) + 1
styleDict.Item(aStyleName) = tempKey
Else
styleDict.Add aStyleName, 1

End If
End If


Next para
End If
Do Until aStory.NextStoryRange Is Nothing
Set aStory = aStory.NextStoryRange
For Each para In aStory.Paragraphs
Set aStyle = para.Style
aStyleName = aStyle.NameLocal
If styleDict.Exists(aStyleName) Then
tempKey = (styleDict.Item(aStyleName)) + 1
styleDict.Item(aStyleName) = tempKey
Else
styleDict.Add aStyleName, 1

End If
getStorytype = Choose(aStory.StoryType, "wdMainTextStory", "wdFootnotesStory", "wdEndnotesStory", "wdCommentsStory", "wdTextFrameStory", "wdEvenPagesHeaderStory", "wdPrimaryHeaderStory", "wdEvenPagesFooterStory", "wdPrimaryFooterStory",

"wdFirstPageHeaderStory", "wdFirstPageFooterStory", "wdFootnoteSeparatorStory", "wdFootnoteContinuationSeparatorStory", "wdFootnoteContinuationNoticeStory", "wdEndnoteSeparatorStory", "wdEndnoteContinuationSeparatorStory", "wdEndnoteContinuationNoticeStory")


Next para

Loop

Next aStory


' Count of styles in the styles dictionary
cStyles = styleDict.Count
vStyles = styleDict.Keys


' Create a new document
' and insert the style names
Documents.Add

For I = 0 To cStyles - 1

Selection.InsertAfter I & " " & vStyles(I) & " " & styleDict.Item(vStyles(I)) & vbCr
Selection.Collapse wdCollapseEnd
Next I

End Sub

Function IsParaEndOfRow(para As Paragraph) As Boolean
If para.Range.Information(wdWithInTable) = True Then
'MsgBox "para.Range.Characters.Count in paraendofrow= " & para.Range.Characters.Count
If para.Range.Cells.Count = 0 Then
IsParaEndOfRow = True
Exit Function
End If
End If
IsParaEndOfRow = False
End Function

Function IsParaEndOfHeaderFooter(para As Paragraph) As Boolean
If para.Range.Information(wdInHeaderFooter) = True Then
MsgBox "para.Range.Characters.Count = " & para.Range.Characters.Count
If para.Range.Characters.Count = 0 Then
IsParaEndOfHeaderFooter = True
Exit Function
End If
End If
IsParaEndOfHeaderFooter = False
End Function

---

Then Keith Soltys posted:
I tried running this and I get a compile error “User defined type not defined” on the line:
Dim styleDict As New Scripting.Dictionary
I assume that this is because I didn’t add the reference you mentioned, but I don’t know how to do that.

---

Then Jessica posted:
You have to add the Scripting Additions to your references. That's where the Dictionary object is defined. Without that you can't use it in VBA.
More detail. These steps may be slightly different in 2013, but in 2010 or 2007 do this:
Open the VBA editor.
Open the Tools menu and select References.
Scroll down a long way until you see Microsoft Scripting Runtime. Check that box and save.
All should work right now.

---

Then Keith replied back:
Got it. That did the trick. Thanks so much.
I need to rebuild some of our templates now that we have Word 2010 (most of them were done in Word 2003 or earlier) and that macro will be useful.