The following macro will produce a report of all Styles in the document, in a sorted table format.
Code:
Sub ReportAllStyles()
Dim Sty As Style, StrAttr As String, Rng As Range
StrAttr = "Style Name" & vbTab & "Type" & vbTab & "Built In" & vbTab & "In Use"
With ActiveDocument
For Each Sty In .Styles
With Sty
StrAttr = StrAttr & vbCr & .NameLocal & vbTab
Select Case .Type
Case wdStyleTypeCharacter: StrAttr = StrAttr & "Character" & vbTab
Case wdStyleTypeLinked: StrAttr = StrAttr & "Linked" & vbTab
Case wdStyleTypeList: StrAttr = StrAttr & "List" & vbTab
Case wdStyleTypeParagraph: StrAttr = StrAttr & "Paragraph" & vbTab
Case wdStyleTypeParagraphOnly: StrAttr = StrAttr & "ParagraphOnly" & vbTab
Case wdStyleTypeTable: StrAttr = StrAttr & "Table" & vbTab
End Select
Select Case .BuiltIn
Case True: StrAttr = StrAttr & "Y" & vbTab
Case Else: StrAttr = StrAttr & "N" & vbTab
End Select
Select Case .InUse
Case True: StrAttr = StrAttr & "Y"
Case Else: StrAttr = StrAttr & "N"
End Select
End With
Next
Set Rng = .Characters.Last
With Rng
.InsertAfter vbCr
.Collapse wdCollapseEnd
.Text = StrAttr
.ConvertToTable Separator:=vbTab, NumColumns:=4, AutoFit:=True, _
AutoFitBehavior:=wdAutoFitContent, DefaultTableBehavior:=wdWord9TableBehavior
With .Tables(1)
With .Rows(1)
.HeadingFormat = True
.Range.Font.Bold = True
End With
.Borders.Enable = False
.Rows.Alignment = wdAlignRowCenter
.Sort ExcludeHeader:=True, CaseSensitive:=False, LanguageID:=wdLanguageNone, _
FieldNumber:="Column 2", SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, _
FieldNumber2:="Column 3", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:=wdSortOrderAscending, _
FieldNumber3:="Column 4", SortFieldType3:=wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending
End With
End With
End With
End Sub
To reduce the report to just Character Styles, you could use:
Code:
Sub ReportCharacterStyles()
Dim Sty As Style, StrAttr As String, Rng As Range
StrAttr = "Style Name" & vbTab & "Type" & vbTab & "Built In" & vbTab & "In Use"
With ActiveDocument
For Each Sty In .Styles
With Sty
Select Case .Type
Case wdStyleTypeCharacter
StrAttr = StrAttr & vbCr & .NameLocal & vbTab
StrAttr = StrAttr & "Character" & vbTab
Select Case .BuiltIn
Case True: StrAttr = StrAttr & "Y" & vbTab
Case Else: StrAttr = StrAttr & "N" & vbTab
End Select
Select Case .InUse
Case True: StrAttr = StrAttr & "Y"
Case Else: StrAttr = StrAttr & "N"
End Select
End Select
End With
Next
Set Rng = .Characters.Last
With Rng
.InsertAfter vbCr
.Collapse wdCollapseEnd
.Text = StrAttr
.ConvertToTable Separator:=vbTab, NumColumns:=4, AutoFit:=True, _
AutoFitBehavior:=wdAutoFitContent, DefaultTableBehavior:=wdWord9TableBehavior
With .Tables(1)
With .Rows(1)
.HeadingFormat = True
.Range.Font.Bold = True
End With
.Borders.Enable = False
.Rows.Alignment = wdAlignRowCenter
.Sort ExcludeHeader:=True, CaseSensitive:=False, LanguageID:=wdLanguageNone, _
FieldNumber:="Column 2", SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, _
FieldNumber2:="Column 3", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:=wdSortOrderAscending, _
FieldNumber3:="Column 4", SortFieldType3:=wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending
End With
End With
End With
End Sub