Automatically created character styles in Word

[larrysulky]

Background: When a user selects part of a paragraph and applies a
paragraph style to the selection, Word (as of Word 2002) creates a
character style to match it, and gives it a linked name that's the
same as the paragraph style, but with " Char" appended. Getting rid of
these linked character styles is ridiculously difficult, but necessary
in my case because many other macros in our production systems will
fail when trying to deal with these styles, and because the users in
this particular system are not supposed to create new styles. The best
solution would be to prevent users from inadvertently creating these
styles in the first place but this seems to be impossible (and yes,
I've tried un-checking the Keep Track of Formatting box).

So I've created a macro to get rid of these styles, and appended it
below. It works, but it can be bloody slow. Does anyone have a more
elegant way of doing this???

Thanks in advance ----


''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RemoveAutoCharStyles()

' PURPOSE:
' Remove character styles that Word has "helpfully" created when
users
' inadvertently apply a paragraph style to a sub-paragraph.

' IMPORTANT:
' Set Tools > References to include library: Microsoft Scripting
Runtime

' LOGIC:
' Create a "swap-style" for every user paragraph style, whether
it's in
' use or not. (The swap-style name is the original name prefixed
by "[!]".)
' Base the swap-style on the original style.
' Then paddle through every paragraph in every story.
' If it's a user paragraph style, apply the corresponding swap-
style.
' Then delete each original user paragraph style and rename the
corresponding
' swap-style to the original name.

' ISSUES:
' (1) If there is already a style that begins "[!]", look out!
' (2) If a user has used a BUILT-IN paragraph style as a character
style,
' this logic won't work. (Hopefully it won't need to; the Apply
Template
' code shouldn't deal with built-in styles anyway.)
' However, a different routine could go through character by
character
' (slowly!) and Clear Formatting on any such styles (the logic
' is available in my DeleteUnusedStyles routine), and when
' all done, the "paragraph and character" style type would revert
back to
' "paragraph". Weirdly, this is NOT the behaviour of non-built-in
styles;
' that is, they will NOT revert back to pure "paragraph" just
because all
' usage of them as character styles has been removed.

On Error GoTo Error_Handler

Dim mySwapStyles As New Scripting.Dictionary ' The long-sought
hash table capability.
Dim myDeleteStyles As New Scripting.Dictionary ' The long-sought
hash table capability.
Dim myStyle As Style
Dim mySwapStyle As Variant ' Must be variant to hold hash key.
Dim myDeleteStyle As Variant ' Must be variant to hold hash key.
Dim myStory As Word.Range


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Define swap styles ("[!]") for all the user paragraph styles.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each myStyle In ActiveDocument.Styles

If (myStyle.Type = wdStyleTypeParagraph) And Not
(myStyle.BuiltIn) Then

mySwapStyles.Add myStyle.NameLocal, 1

End If

Next

For Each mySwapStyle In mySwapStyles.keys

ActiveDocument.Styles.Add Name:="[!]" & mySwapStyle,
Type:=wdStyleTypeParagraph
ActiveDocument.Styles("[!]" & mySwapStyle).BaseStyle =
mySwapStyle
Application.StatusBar = "Declared " & mySwapStyle

Next


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Apply swap styles for every usage of user paragraph styles.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each myStory In ActiveDocument.StoryRanges

Do

For Each myText In myStory.Paragraphs

If (myText.Style.BuiltIn = False) Then

myText.Style = ActiveDocument.Styles("[!]" &
myText.Style.NameLocal)
Application.StatusBar = "Applied " &
myText.Style.NameLocal

End If

Next myText

Set myStory = myStory.NextStoryRange

Loop Until myStory Is Nothing

Next


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Delete all user paragraph styles and rename swap styles back
''' to original names.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each mySwapStyle In mySwapStyles.keys

ActiveDocument.Styles(mySwapStyle).Delete
Application.OrganizerRename Source:=ActiveDocument.FullName, _
Name:="[!]" & mySwapStyle, _
NewName:=mySwapStyle, _
Object:=wdOrganizerObjectStyles
Application.StatusBar = "Swapped " & mySwapStyle

Next


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Delete all user styles that end in " Char".

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each myStyle In ActiveDocument.Styles

If (Right(myStyle.NameLocal, 5) = " Char") And Not
(myStyle.BuiltIn) Then

myDeleteStyles.Add myStyle.NameLocal, 1
Application.StatusBar = "Deleted " & myStyle.NameLocal

End If

Next

For Each myDeleteStyle In myDeleteStyles.keys

ActiveDocument.Styles(myDeleteStyle).Delete

Next

GoTo bye

Error_Handler:
If Err.Number <> 0 Then
' 424 just means cursor wasn't in a shape
' 5941 means it wasn't in a table
Err.Raise Err.Number, Description:="cleanup.bas |
RemoveAutoCharStyles(): " & Err.Description
End If

bye:

End Sub

 

[Klaus Linke]

Hi Larry,

You could try the macro I use... or adapt it. It looks at all the styles,
but only turns the linked character ("Char") styles (which are usually
invisible) into regular character styles. You have to clean them up later
on, say replace them with a sensible character style or the "Default
Paragraph Font" and then delete them once they aren't in use any more.
If you just delete them immediately, you may loose formatting.
Deleting them doesn't even always work (... there's sometimes link styles
whose names start with a blank that can't be deleted).

On the other hand, the macro not only attacks the "Char" styles, but also
fixes issues when built-in paragraph styles become linked to other, built-in
character styles for no good reason.

Debug.Print lets you see the style pairs (paragraph style / linked character
style) that have been fixed.

Regards,
Klaus


Sub LinkStylesToRegularCharStyles()
Dim myStyle As Style
Dim myStyleLinkStyle As Style
For Each myStyle In ActiveDocument.Styles
' only look at character styles, and links style <> Normal:
If myStyle.Type = wdStyleTypeCharacter And _
myStyle.LinkStyle <> ActiveDocument.Styles(wdStyleNormal) _
Then
Set myStyleLinkStyle = myStyle.LinkStyle
Debug.Print myStyleLinkStyle, myStyle
myStyle.LinkStyle = _
ActiveDocument.Styles(wdStyleNormal)
myStyleLinkStyle.LinkStyle = _
ActiveDocument.Styles(wdStyleNormal)
End If
Next myStyle
End Sub

Background: When a user selects part of a paragraph and applies a
paragraph style to the selection, Word (as of Word 2002) creates a
character style to match it, and gives it a linked name that's the
same as the paragraph style, but with " Char" appended. Getting rid of
these linked character styles is ridiculously difficult, but necessary
in my case because many other macros in our production systems will
fail when trying to deal with these styles, and because the users in
this particular system are not supposed to create new styles. The best
solution would be to prevent users from inadvertently creating these
styles in the first place but this seems to be impossible (and yes,
I've tried un-checking the Keep Track of Formatting box).

So I've created a macro to get rid of these styles, and appended it
below. It works, but it can be bloody slow. Does anyone have a more
elegant way of doing this???

Thanks in advance ----


''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RemoveAutoCharStyles()

' PURPOSE:
' Remove character styles that Word has "helpfully" created when
users
' inadvertently apply a paragraph style to a sub-paragraph.

' IMPORTANT:
' Set Tools > References to include library: Microsoft Scripting
Runtime

' LOGIC:
' Create a "swap-style" for every user paragraph style, whether
it's in
' use or not. (The swap-style name is the original name prefixed
by "[!]".)
' Base the swap-style on the original style.
' Then paddle through every paragraph in every story.
' If it's a user paragraph style, apply the corresponding swap-
style.
' Then delete each original user paragraph style and rename the
corresponding
' swap-style to the original name.

' ISSUES:
' (1) If there is already a style that begins "[!]", look out!
' (2) If a user has used a BUILT-IN paragraph style as a character
style,
' this logic won't work. (Hopefully it won't need to; the Apply
Template
' code shouldn't deal with built-in styles anyway.)
' However, a different routine could go through character by
character
' (slowly!) and Clear Formatting on any such styles (the logic
' is available in my DeleteUnusedStyles routine), and when
' all done, the "paragraph and character" style type would revert
back to
' "paragraph". Weirdly, this is NOT the behaviour of non-built-in
styles;
' that is, they will NOT revert back to pure "paragraph" just
because all
' usage of them as character styles has been removed.

On Error GoTo Error_Handler

Dim mySwapStyles As New Scripting.Dictionary ' The long-sought
hash table capability.
Dim myDeleteStyles As New Scripting.Dictionary ' The long-sought
hash table capability.
Dim myStyle As Style
Dim mySwapStyle As Variant ' Must be variant to hold hash key.
Dim myDeleteStyle As Variant ' Must be variant to hold hash key.
Dim myStory As Word.Range


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Define swap styles ("[!]") for all the user paragraph styles.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each myStyle In ActiveDocument.Styles

If (myStyle.Type = wdStyleTypeParagraph) And Not
(myStyle.BuiltIn) Then

mySwapStyles.Add myStyle.NameLocal, 1

End If

Next

For Each mySwapStyle In mySwapStyles.keys

ActiveDocument.Styles.Add Name:="[!]" & mySwapStyle,
Type:=wdStyleTypeParagraph
ActiveDocument.Styles("[!]" & mySwapStyle).BaseStyle =
mySwapStyle
Application.StatusBar = "Declared " & mySwapStyle

Next


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Apply swap styles for every usage of user paragraph styles.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each myStory In ActiveDocument.StoryRanges

Do

For Each myText In myStory.Paragraphs

If (myText.Style.BuiltIn = False) Then

myText.Style = ActiveDocument.Styles("[!]" &
myText.Style.NameLocal)
Application.StatusBar = "Applied " &
myText.Style.NameLocal

End If

Next myText

Set myStory = myStory.NextStoryRange

Loop Until myStory Is Nothing

Next


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Delete all user paragraph styles and rename swap styles back
''' to original names.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each mySwapStyle In mySwapStyles.keys

ActiveDocument.Styles(mySwapStyle).Delete
Application.OrganizerRename Source:=ActiveDocument.FullName, _
Name:="[!]" & mySwapStyle, _
NewName:=mySwapStyle, _
Object:=wdOrganizerObjectStyles
Application.StatusBar = "Swapped " & mySwapStyle

Next


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Delete all user styles that end in " Char".

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each myStyle In ActiveDocument.Styles

If (Right(myStyle.NameLocal, 5) = " Char") And Not
(myStyle.BuiltIn) Then

myDeleteStyles.Add myStyle.NameLocal, 1
Application.StatusBar = "Deleted " & myStyle.NameLocal

End If

Next

For Each myDeleteStyle In myDeleteStyles.keys

ActiveDocument.Styles(myDeleteStyle).Delete

Next

GoTo bye

Error_Handler:
If Err.Number <> 0 Then
' 424 just means cursor wasn't in a shape
' 5941 means it wasn't in a table
Err.Raise Err.Number, Description:="cleanup.bas |
RemoveAutoCharStyles(): " & Err.Description
End If

bye:

End Sub

 

[larrysulky]

Klaus, thank you! Your approach is much faster and more elegant than
mine. I only needed to add the deletion code (I already had it in
another module and luckily I use the same variable naming convention
as you!). The whole thing is shown below. I works very quickly and
catches styles no matter which story within the document they are used
in. I don't have to worry about losing the formatting on the bogus "
Char" styles, so I just go ahead and brutally delete them!

Thanks again!!
--larry

'''''''''''''''''''''''''''''''''''''''''''''''

Sub DeleteAutoCharStyles()
Dim myStyle As Style
Dim myStyleLinkStyle As Style
Dim myLog As String
myLog = ""
For Each myStyle In ActiveDocument.Styles
' only look at character styles, and links style <> Normal:
If myStyle.Type = wdStyleTypeCharacter And _
myStyle.LinkStyle <> ActiveDocument.Styles(wdStyleNormal) _
Then
Set myStyleLinkStyle = myStyle.LinkStyle
Debug.Print myStyleLinkStyle, myStyle
myStyle.LinkStyle = _
ActiveDocument.Styles(wdStyleNormal)
myStyleLinkStyle.LinkStyle = _
ActiveDocument.Styles(wdStyleNormal)
End If
' Now delete if it's a bogus Char style.
If (myStyle.BuiltIn = False) And (Right(myStyle.NameLocal, 5) =
" Char") Then
Debug.Print "", "Deleting " & myStyle.NameLocal
myLog = myLog & myStyle.NameLocal & vbCrLf
myStyle.Delete
deleteCount = deleteCount + 1
End If
Next
MsgBox myLog, , "Deleted these bogus character styles:"
End Sub

 

[Klaus Linke]

Hi Larry,

Great! And thanks for posting the code. People who work with other language
versions (or receive international Word documents) may need to adapt the
code a little bit.
"Char" is "Zchn" in German, "Car" in Portuguese... I don't know about other
languages.

Regards,
Klaus