Option Explicit
Sub ReportAllStyles()
Dim oStyle As Style, strAttr As String, oRng As Range
Dim oTbl As Word.Table
  strAttr = "Style Name" & vbTab & "Type" & vbTab & "Built In" ' & vbTab & "In Use"
  With ActiveDocument
    For Each oStyle In .Styles
     With oStyle
       If .InUse Then
         'Is it really "In Use" i.e., applied to text in the document?
         If StyleInUse(ActiveDocument, oStyle) = "Y" Then
           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"
             Case Else:                     strAttr = strAttr & "N"
           End Select
        End If
     End If
     End With
    Next
    Set oRng = .Characters.Last
    With oRng
      .InsertAfter vbCr
      .Collapse wdCollapseEnd
      .Text = strAttr
      Set oTbl = .ConvertToTable(Separator:=vbTab, NumColumns:=3, DefaultTableBehavior:=wdWord9TableBehavior)
      With oTbl
        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
      End With
    End With
  End With
End Sub
Sub ReportCharacterStyles()
Dim oStyle As Style, strAttr As String, oRng As Range
strAttr = "Style Name" & vbTab & "Type" & vbTab & "Built In" ' & vbTab & "In Use"
Dim oTbl As Word.Table
  With ActiveDocument
    For Each oStyle In .Styles
      With oStyle
        If .InUse Then
          'Is it really "In Use" i.e., applied to text in the document?
          If StyleInUse(ActiveDocument, oStyle) = "Y" Then
            Select Case .Type
              Case wdStyleTypeCharacter
                strAttr = strAttr & vbCr & .NameLocal & vbTab
                strAttr = strAttr & "Character" & vbTab
              Select Case .BuiltIn
                Case True:                     strAttr = strAttr & "Y"
                Case Else:                     strAttr = strAttr & "N"
              End Select
            End Select
          End If
        End If
      End With
    Next
    Set oRng = .Characters.Last
    With oRng
      .InsertAfter vbCr
      .Collapse wdCollapseEnd
      .Text = strAttr
      Set oTbl = .ConvertToTable(Separator:=vbTab, NumColumns:=3, DefaultTableBehavior:=wdWord9TableBehavior)
      With oTbl
        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
      End With
    End With
  End With
End Sub
Function StyleInUse(Doc As Document, oStyle As Style) As String
Dim rngStory As Word.Range
Dim strResult As String
Dim lngValidator As Long
Dim oShp As Shape
Dim bResult As Boolean
  'Fix the skipped blank Header/Footer problem
  lngValidator = ActiveDocument.Sections(1).Headers(1).Range.StoryType
 
  'Iterate through all story types in the current document
  For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
      bResult = FindStyle(rngStory, oStyle)
      If bResult Then GoTo Result
      On Error Resume Next
      Select Case rngStory.StoryType
        Case 6, 7, 8, 9, 10, 11
          If rngStory.ShapeRange.Count > 0 Then
            For Each oShp In rngStory.ShapeRange
              If oShp.TextFrame.HasText Then
                bResult = FindStyle(oShp.TextFrame.TextRange, oStyle)
                If bResult Then GoTo Result
              End If
            Next
          End If
        Case Else
          'Do Nothing
      End Select
      On Error GoTo 0
      'Get next linked story (if any)
      Set rngStory = rngStory.NextStoryRange
    Loop Until rngStory Is Nothing
  Next
Result:
  If bResult = True Then
    StyleInUse = "Y"
  Else
    StyleInUse = "N"
  End If
 
End Function
 
Function FindStyle(oRng As Range, oStyle As Style) As Boolean
Dim bRslt As Boolean
bRslt = False
Selection.Find.ClearFormatting
  With oRng.Find
    .Text = ""
    .Style = oStyle
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    If .Execute Then FindStyle = True
  End With
End Function