Microsoft Office Forums - View Single Post - Style in Use Macro-Need Help Optimizing Code

freda0255 · 07-31-2014, 10:00 PM

I found and modified a macro that displays the styles that are really in use in a document.

As I understand it, Word's built-in command to display "styles in use" will display a style if the style was ever in use in a document, even if the style is not currently in use.

I am asking for help in making the macro run faster. The goal is to make it easier for users to select the styles they need by cleaning up the style pane. The users at my company will need to run the macro many times per day. Currently, the macro takes about 30 seconds to run on a 10 page document.

Thank you for your assistance.

Freda

Code:

Sub StylesInUseForReal() 
    Dim oStyle As Style 
    Dim sStyle As String 
    Dim actDoc As Document 
    Dim newDoc As Document 
    Dim sect As section 
    Dim rng As Range 
    Dim sName As String 
    Set actDoc = ActiveDocument 
    sName = actDoc.FullName 
    StatusBar = "Analyzing syles in use! Please be patient! This may take some time." & _ 
    "Hit Ctrl-Break to stop the macro." 
    On Error Resume Next 
    For Each oStyle In actDoc.Styles 
        If oStyle.InUse And IsStyleInUseInDoc(oStyle, actDoc) Then 
            oStyle.Visibility = False 
        End If 
    Next oStyle 
    StyleShowStyleInUse 
    MsgBox "Styles in Use Macro is Complete." 
End Sub 
 
Function IsStyleInUseInDoc(ByVal oStyle As Style, ByVal oDoc As Document) As Boolean 
    Dim oRange As Range 
    Dim bReturn As Boolean 
    bReturn = False 
    For Each oRange In oDoc.StoryRanges 
        If IsStyleInRange(oStyle, oRange) = True Then 
            bReturn = True 
        End If 
    Next oRange 
    IsStyleInUseInDoc = bReturn 
End Function 

 Function IsStyleInRange(ByVal oStyle As Style, ByVal oRange As Range) As Boolean 
    With oRange.Find 
        .ClearFormatting 
        .Style = oStyle 
        .Forward = True 
        .Format = True 
        .Text = "" 
        .Execute 
    End With 
    If oRange.Find.Found = True Then 
        IsStyleInRange = True 
    Else 
        IsStyleInRange = False 
    End If 
End Function 
 
Sub StyleShowStyleInUse() 
    ActiveDocument.FormattingShowFont = False 
    ActiveDocument.FormattingShowParagraph = False 
    ActiveDocument.FormattingShowNumbering = False 
    ActiveDocument.FormattingShowNextLevel = False 
    ActiveDocument.FormattingShowFilter = wdShowFilterStylesInUse 
    ActiveDocument.StyleSortMethod = wdStyleSortByName 
End Sub