Using Word 2003
Jezebel said:
Use the Organizer:
1. Delete ALL styles from the template (ignore the error on the built-ins)
2. Copy styles in use from the document.
Hi G.,
You'll probably have to delete unused styles from the document first, before
you copy them to the template.
You could select and copy/paste everything but the last paragraph mark into
a new document.
With the macros below you can maybe do a better job.
They show you where some style is used, to help you decide if you want to
keep/delete it.
They also make Char styles (or, in general, link styles) visible (which are
usually hidden from you), and allow you to get rid of them, too.
The macros contain some redundant code... haven't had time to clean them up.
Greg Maxey has a more elaborate version on his web page that checks all
story ranges and has some additional bells and whistles, but some bug in
Word seems to cause errors.
Regards,
Klaus
Sub DeleteUnusedStyles()
Dim myStyle As Style
Call LinkStyleToRegularCharStyle
For Each myStyle In ActiveDocument.Styles
If myStyle.InUse Then
Select Case myStyle
Case ActiveDocument.Styles(wdStyleDefaultParagraphFont)
Case ActiveDocument.Styles(wdStyleNormal)
Case ActiveDocument.Styles(wdStyleNormalTable)
Case ActiveDocument.Styles(-108) ' No list
Case ActiveDocument.Styles(wdStyleHeading1)
Case ActiveDocument.Styles(wdStyleHeading2)
Case ActiveDocument.Styles(wdStyleHeading3)
Case ActiveDocument.Styles(wdStyleHeading4)
Case ActiveDocument.Styles(wdStyleHeading5)
Case ActiveDocument.Styles(wdStyleHeading6)
Case ActiveDocument.Styles(wdStyleHeading7)
Case ActiveDocument.Styles(wdStyleHeading8)
Case ActiveDocument.Styles(wdStyleHeading9)
Case Else
On Error GoTo NextStyle
Selection.Collapse (wdCollapseStart)
With Selection.Find
.ClearFormatting
.Style = myStyle
.Forward = True
.Wrap = wdFindContinue
.Execute FindText:="", Format:=True
If .Found = False Then
StatusBar = myStyle.NameLocal
Select Case MsgBox("Delete?", vbYesNoCancel + vbQuestion,
myStyle.NameLocal)
Case vbYes
If myStyle.LinkStyle <> ActiveDocument.Styles(wdStyleNormal)
Then
myStyle.LinkStyle = ActiveDocument.Styles(wdStyleNormal)
End If
myStyle.Delete
Case vbCancel
Exit Sub
End Select
Else
Select Case MsgBox("Keep?", vbYesNoCancel + vbInformation,
myStyle.NameLocal)
Case vbNo
If myStyle.LinkStyle <> ActiveDocument.Styles(wdStyleNormal)
Then
myStyle.LinkStyle = ActiveDocument.Styles(wdStyleNormal)
End If
myStyle.Delete
Case vbCancel
Exit Sub
End Select
End If
End With
End Select
Else
If myStyle.BuiltIn = False Then
If myStyle.LinkStyle <> ActiveDocument.Styles(wdStyleNormal) Then
myStyle.LinkStyle = ActiveDocument.Styles(wdStyleNormal)
End If
myStyle.Delete
End If
End If
NextStyle:
Next myStyle
End Sub
Sub LinkStyleToRegularCharStyle()
Dim myStyle As Style
For Each myStyle In ActiveDocument.Styles
If myStyle.LinkStyle <> _
ActiveDocument.Styles(wdStyleNormal) Then
' MsgBox myStyle.LinkStyle
myStyle.LinkStyle = _
ActiveDocument.Styles(wdStyleNormal)
End If
Next myStyle
