Intelligently deleting "xxx Char" styles

[Larry]

Hi, All -- Some time ago I started a thread about deleting "xxx Char"
styles. One of the solutions offered did a good job but reverted any
paragraph that had a "xxx Char" style in it to the Normal paragraph
style, which was rather heavy-handed. Here's an updated version that
re-applies the intended paragraph style:

Sub DeleteAutoCharStyles()
Dim myStyle As Style
Dim myStyleLinkStyle As Style
Dim myLog As String
myLog = ""
For Each myStyle In ActiveDocument.Styles

If myStyle.Type = wdStyleTypeCharacter And _
myStyle.LinkStyle <> ActiveDocument.Styles
(wdStyleNormal) Then
Set myStyleLinkStyle = myStyle.LinkStyle
Debug.Print myStyleLinkStyle, Asc(myStyle.NameLocal),
myStyle
myStyle.LinkStyle = ActiveDocument.Styles(wdStyleNormal)
myStyleLinkStyle.LinkStyle = ActiveDocument.Styles
(wdStyleNormal)
End If

If (myStyle.BuiltIn = False) And (Right(myStyle.NameLocal, 5)
= " Char") Then
Dim realStyleName As String
realStyleName = left(myStyle.NameLocal, Len
(myStyle.NameLocal) - 5)
'MsgBox realStyleName, , "DEBUG: realStyleName"
Selection.HomeKey Unit:=wdStory

With Selection.Find
.ClearFormatting
.Style = ActiveDocument.Styles(myStyle.NameLocal)
.Replacement.ClearFormatting
.Replacement.Style = ActiveDocument.Styles
(realStyleName)
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Debug.Print "", "Deleting " & myStyle.NameLocal, Asc
(myStyle.NameLocal)
myLog = myLog & myStyle.NameLocal & vbCrLf
myStyle.Delete
deleteCount = deleteCount + 1
End If
Next
Bye:
If (myLog <> "") Then
MsgBox myLog, , "Deleted these bogus character styles:"
Else
MsgBox "No bogus character styles found.", , "Done!"
End If
End Sub


A single pass through will not catch multiply-suffixed styles ("H1
Char Char Char"), but just running the macro until it reports all
clear should do the trick. BTW, I never did find a way to
programmatically delete styles whose name begins with a space
character (" Char Char", for example), but have been using the style
organizer to get rid of them.

Hope this is of use.
--L

 

[teri dickinson]

Thanks Larry.

It runs fine in a document with no "Char" styles but when I run it in a
document that has some it returns Runtime error 5941, the Requested member of
the collection does not exist.

The Debugger points me to the section below with the .Style line highlighted.

Any help appreciated!

Thanks

With Selection.Find
..ClearFormatting
..Style = ActiveDocument.Styles(myStyle.NameLocal)
..Replacement.ClearFormatting
..Replacement.Style = ActiveDocument.Styles(realStyleName)
..Text = ""
..Replacement.Text = ""
..Forward = True
..Wrap = wdFindContinue
..Format = True

 

[Larry]

Thanks Larry.

It runs fine in a document with no "Char" styles but when I run it in a
document that has some it returns Runtime error 5941, the Requested member of
the collection does not exist.

The Debugger points me to the section below with the .Style line highlighted.

Any help appreciated!

Thanks

With Selection.Find
.ClearFormatting
.Style = ActiveDocument.Styles(myStyle.NameLocal)
.Replacement.ClearFormatting
.Replacement.Style = ActiveDocument.Styles(realStyleName)
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True












- Show quoted text -

Hi, Teri -- as it happens I just recently made a small fix, which
should mostly clear things up for you. In the code, where it says:

Dim realStyleName As String
realStyleName = left(myStyle.NameLocal, Len
(myStyle.NameLocal) - 5)
'MsgBox realStyleName, , "DEBUG: realStyleName"

Change it to:

Dim realStyleName As String
realStyleName = myStyle.NameLocal
While Right(realStyleName, 5) = " Char"
realStyleName = left(realStyleName, Len(realStyleName)
- 5)
'MsgBox realStyleName, , "DEBUG"
Wend

In other words, paddle through realStyleName from back to front and
remove ALL " Char" suffixes to find the original stylename

Now, this will not take care of styles that begin with a space -- "
Char" all by itself as a stylename, for example. Those HAVE to be
cleared out first by hand through the Style pane > Custom > Styles >
Organizer, because VBA cannot see stylenames that begin with a space.
(It also can't deal with a " Char"-suffixed style whose original style
has disappeared, but that should be extraordinarily rare [it should be
impossible, but you know how that goes].) So first check through the
Organizer and look at the top of the list for any styles that begin
with a space character; remove them. Then run DeleteAutoCharStyles and
all should be well.

---larry

 

[teri dickinson]

Thanks. I had them show up in a document I had just started so I deleted that
one started again but we have some others floating around that we can test it
on.

Thanks!

Teri

Thanks Larry.

It runs fine in a document with no "Char" styles but when I run it in a
document that has some it returns Runtime error 5941, the Requested member of
the collection does not exist.

The Debugger points me to the section below with the .Style line highlighted.

Any help appreciated!

Thanks

With Selection.Find
.ClearFormatting
.Style = ActiveDocument.Styles(myStyle.NameLocal)
.Replacement.ClearFormatting
.Replacement.Style = ActiveDocument.Styles(realStyleName)
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True












- Show quoted text -

Hi, Teri -- as it happens I just recently made a small fix, which
should mostly clear things up for you. In the code, where it says:

Dim realStyleName As String
realStyleName = left(myStyle.NameLocal, Len
(myStyle.NameLocal) - 5)
'MsgBox realStyleName, , "DEBUG: realStyleName"

Change it to:

Dim realStyleName As String
realStyleName = myStyle.NameLocal
While Right(realStyleName, 5) = " Char"
realStyleName = left(realStyleName, Len(realStyleName)
- 5)
'MsgBox realStyleName, , "DEBUG"
Wend

In other words, paddle through realStyleName from back to front and
remove ALL " Char" suffixes to find the original stylename

Now, this will not take care of styles that begin with a space -- "
Char" all by itself as a stylename, for example. Those HAVE to be
cleared out first by hand through the Style pane > Custom > Styles >
Organizer, because VBA cannot see stylenames that begin with a space.
(It also can't deal with a " Char"-suffixed style whose original style
has disappeared, but that should be extraordinarily rare [it should be
impossible, but you know how that goes].) So first check through the
Organizer and look at the top of the list for any styles that begin
with a space character; remove them. Then run DeleteAutoCharStyles and
all should be well.

---larry