Results 1 to 7 of 7
  1. #1
    3 Star Lounger
    Join Date
    Mar 2003
    Location
    Elkins Park, Pennsylvania, USA
    Posts
    325
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Searching for Styles (Word XP)

    Hi, again.
    I was wondering if anyone else out there has ever written code to delete unused styles from a document. I support a word-processing center, and there are many documents with scores of styles in them. My job is to create a tool that deletes any style that's not being used.
    I have concluded that I need to utilize search and replace; the Style object's InUse property doesn't help since it doesn't indicate if it's actually APPLIED to any text. However, I've noticed that when I use Edit Find manually and look for a style, it will find it even if it's only used in a header (as opposed to the main document.) However, when I write the (apparently) same function in VBA, it will only find it within the main body of the document. Is there something I'm missing, or am I going to have to resign myself to searching each "story" individually?
    <font face="Comic Sans MS">That's what you do in a herd; you look out for each other!</font face=comic> - Mike

  2. #2
    Uranium Lounger
    Join Date
    Dec 2000
    Location
    Los Angeles Area, California, USA
    Posts
    7,453
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Searching for Styles (Word XP)

    Hi Mike:
    The following macro was posted somewhere here in the Lounge by Guy Gallo. I'm posting it again because our search function will not be available for some time.<pre>Sub NukeStyleNotInDocument()
    ' by Guy Gallo
    ' Purpose: remove all user styles that are not ACTIVELY
    ' in use in the current document
    ' remove built-in styles that are not ACTIVELY in use
    ' from the style list

    'Adapted from a macro by Paul Cornell
    'http://office.microsoft.com/assistance/2002/articles/pwWordstyles.aspx


    Dim strTitle As String
    Dim astrstyles() As String
    Dim objstyle As Style
    Dim objDocument As Word.Document
    Dim intCount As Integer
    Dim sh ' Added 6/26

    ' Get the title of the active Word document.
    strTitle = _
    ActiveDocument.BuiltInDocumentProperties(wdPropert yTitle)

    ' Store, in memory, each style in the active document,
    ' including whether the style is in use.
    'Turn on Hidden
    sh = ActiveDocument.ActiveWindow.View.ShowHiddenText
    ActiveDocument.ActiveWindow.View.ShowHiddenText = True

    For Each objstyle In ActiveDocument.Styles

    ReDim Preserve astrstyles(intCount)
    'GG Mod
    If objstyle.BuiltIn = False Then
    If Not StyleInDoc(objstyle) Then
    Debug.Print "Removing " & objstyle
    objstyle.Delete
    Else
    Debug.Print "In use: " & objstyle
    astrstyles(intCount) = objstyle & " (style in Use)"
    intCount = intCount + 1
    End If

    Else
    If objstyle.InUse And Not StyleInDoc(objstyle) Then
    objstyle.Hidden = True
    Debug.Print "Hiding: " & objstyle
    Else
    Debug.Print "In Use: " & objstyle
    astrstyles(intCount) = objstyle & " (style in Use)"
    intCount = intCount + 1
    End If
    '**********
    End If
    Next objstyle

    'Set ShowHidden back
    ActiveDocument.ActiveWindow.View.ShowHiddenText = sh

    ' Create a new Word document to report the results.
    Set objDocument = Word.Documents.Add

    With objDocument.Range

    ' Report the results.
    .InsertAfter "styles in " & strTitle & ":"
    .InsertParagraphAfter
    .Collapse Direction:=wdCollapseEnd

    For intCount = 1 To UBound(astrstyles)

    .InsertAfter astrstyles(intCount)
    .InsertParagraphAfter
    .Collapse Direction:=wdCollapseEnd

    Next intCount

    End With

    MsgBox Prompt:="Done!"
    out:
    End Sub


    Function StyleInDoc(sty)
    'gg
    'Check if a style is in active use.

    Dim myRange As Range
    Set myRange = ActiveDocument.Content

    With myRange.Find
    .ClearFormatting
    .Style = sty
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False


    StyleInDoc = .Execute(FindText:="", Forward:=True, _
    Format:=True) = True
    .ClearFormatting
    End With

    End Function</pre>

    Hope this helps,

  3. #3
    3 Star Lounger
    Join Date
    Mar 2003
    Location
    Elkins Park, Pennsylvania, USA
    Posts
    325
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Searching for Styles (Word XP)

    That actually looked a lot like what I had, but it only searches the main body of the document. In my case, an author may have a style called "Fred" being used ONLY on a single line of the header for section 3 (which isn't linked to the headers for sections 2 or 4). I'm sure I can find some kludgy way to iterate through all of the headers and footers, but I thought something like the following would do it. (My sample code doesn't really delete the style.) I even used the NextStoryRange method, like the help file suggested. It does indeed loop through each section's headers (I tested it by having it insert text), but it WON'T FIND THE BLASTED STYLE! (Sorry that it didn't bring in the indents.

    This is frustrating.

    Sub MAIN()
    Dim cStyle As Style, numStyles As Integer, cStyleFound As Boolean, rStyles As String

    numStyles = 0
    rStyles = ""

    On Error GoTo Err_RemovingStyles

    For Each cStyle In ActiveDocument.Styles
    If cStyle.BuiltIn = False Then
    StatusBar = "Checking style " & cStyle.NameLocal
    If StyleFound(cStyle.NameLocal) = False Then
    numStyles = numStyles + 1
    rStyles = rStyles & cStyle.NameLocal & vbCrLf
    MsgBox "Could not find style " & cStyle.NameLocal, vbInformation, "Delete Unused Styles"
    Debug.Print cStyle.NameLocal & " deleted..."
    ' cStyle.Delete
    End If
    End If
    Next

    If numStyles > 0 Then MsgBox "The following " & numStyles & " styles are not being used and were deleted:" & vbCrLf & rStyles, vbInformation, "Test"

    Err_RemovingStyles:
    Selection.HomeKey wdStory
    Selection.Find.ClearFormatting

    End Sub

    Function StyleFound(StyleName As String) As Boolean
    Dim aStory As Range, sFound As Boolean

    sFound = False
    Set aStory = ActiveDocument.Content

    With aStory.Find
    .ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    End With
    aStory.Find.Style = ActiveDocument.Styles(StyleName)

    For Each aStory In ActiveDocument.StoryRanges
    aStory.Find.Execute
    If aStory.Find.Found = True Then sFound = True

    'added the following while/wend as per the NextStoryRange help topic, but it still won't find it.
    While Not (aStory.NextStoryRange Is Nothing)
    Set aStory = aStory.NextStoryRange
    aStory.Find.Execute
    If aStory.Find.Found = True Then sFound = True
    Wend
    Next aStory

    StyleFound = sFound

    End Function
    <font face="Comic Sans MS">That's what you do in a herd; you look out for each other!</font face=comic> - Mike

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Searching for Styles (Word XP)

    Can you post a (preferably small) document that demonstrates the problem? You can replace sensitive text with dummy text.

  5. #5
    3 Star Lounger
    Join Date
    Mar 2003
    Location
    Elkins Park, Pennsylvania, USA
    Posts
    325
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Searching for Styles (Word XP)

    Sure. This is one I put together just to test the code.

    In this doc, there is a style called "Fred" that is applied to the footer in the second section. Interestingly (i.e. frustratingly), after I tested (and failed) the code, I tried to record a macro to see if I missed anything. It left in a line about paragraph borders that I ignored. But when I ran the one I'd just recorded, IT didn't work, either. (If you wan to try it, I recorded it looking for the style Fred and cancelled the recorder after it found the first occurance but before I closed the EditFind dialog box.) Then i deleted the line about the paragraph borders and it ran OK. Then I ran my own code, and IT ran OK. THEN I found out that my code was suddenly returned false positives!! (i.e. the .Find.Found variable always returned TRUE.)
    I'm thinking it's not just my code...
    Attached Files Attached Files
    <font face="Comic Sans MS">That's what you do in a herd; you look out for each other!</font face=comic> - Mike

  6. #6
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Searching for Styles (Word XP)

    I doubt that I can solve it, but one problem with the code may be that Find.Execute modifies the Range object it is applied to, so that the loop index is messed up.

  7. #7
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts

    Re: Searching for Styles (Word XP)

    Here is what I believe Word means by its "stories": <post#=259246>post 259246</post#>. That whole thread is a treasure trove of help on this issue.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •