VBA to remove all Character Styles but keep formatting

[Bernadette]

Hello,

I have a macro that removes all Character Styles from the body of the document but I would like to keep the superscript that was in the Footnote Reference character style as well as the formatting that is in other character styles. Ideally I would like the macro to remove character styles from the actual footnotes at the bottom of the pages not just in the body of the document. Any help is greatly appreciated!

This is my code:

Selection.WholeStory
On Error Resume Next
Selection.ClearCharacterStyle
On Error GoTo 0

Thanks,
Bernadette

[Bernadette]

I can accomplish getting rid of the Footnote Reference character style and replacing it with superscript by doing what you see below. However I need a macro to automate this.



Select the first footnote reference in the body of the document
Home, Editing, Select, Select Text with similar formatting
Ctrl spacebar
Home, Font, click Superscript

[Aussiebear]

Bernadette, Since you know the steps, have you tried recording a macro doing just exactly that?

[Bernadette]

Yes I did try recording the macro by recording the steps but it didn't work.

[Aussiebear]

I would have thought one of the word guru's might have been here by now. Since they haven't, have you had a look at this thread https://www.msofficeforums.com/word/13040-remove-styles-keep-formatting.html

[Bernadette]

Thanks but I don't want to save it as an RTF, as I would lose a lot of formatting.

[Paul_Hossler]

Why do you want to delete the Style but keep the formatting?

It seems to me that the final result would look the same, but Styles are one of Word's most useful and powerful features

[Bernadette]

The character styles are causing problems when the document is published on a different platform. Sometimes the text disappears or has weird text appear. It looks like I won't be getting an answer here so I will have to live with it. Thanks to everyone who replied.

[Bernadette]

I was able to get it to work except it does not put the superscript back into the footnote reference number at the bottom of the page but it now deletes character styles both in the body and in the footnote text of the document. Here is the code:


Sub DeleteFootnoteReferenceCharacterStyle()
' Delete footnote reference character style and replace with superscript font in the body of the document
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Footnote Reference")
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Bold = False
.SmallCaps = False
.AllCaps = False
.Superscript = True
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveDocument.Styles("Footnote Reference").Delete
' Delete all character styles in the body of the document and in footnotes
Dim aStl As Style
On Error Resume Next
For Each aStl In ActiveDocument.Styles
If aStl.Type = wdStyleTypeCharacter Then
ActiveDocument.Styles(aStl).Delete
End If
Next aStl
End Sub

[JakaylaKeeb]

I was able to get it to work except it does not put the superscript back into the footnote reference number at the bottom of the page but it now deletes character styles both in the body and in the footnote text of the document. Here is the code:


Sub DeleteFootnoteReferenceCharacterStyle()
' Delete footnote reference character style and replace with superscript font in the body of the document
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Footnote Reference")
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Bold = False
.SmallCaps = False
.AllCaps = False
.Superscript = True
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveDocument.Styles("Footnote Reference").Delete
' Delete all character styles in the body of the document and in footnotes
Dim aStl As Style
On Error Resume Next
For Each aStl In ActiveDocument.Styles
If aStl.Type = wdStyleTypeCharacter Then
ActiveDocument.Styles(aStl).Delete
End If
Next aStl
End Sub
This code works well. I tried it. You are so good!

[Aussiebear]

Maybe try this;



Sub RemoveCharacterStylesExceptSuperscriptInFootnoteReferences()
Dim storyRange As Range
Dim charStyle As Style
Dim charRange As Range
Dim supRange As Range
Dim supStyle As Style
' Set the style for superscript within footnote references
On Error Resume Next
' Handle potential error if style doesn't exist
Set supStyle = ActiveDocument.Styles("Footnote Reference")
On Error GoTo 0
If supStyle Is Nothing Then
MsgBox "Footnote Reference style not found. Macro will remove all character styles.", vbExclamation End If
' Loop through all stories (main text, headers, footers, etc.)
For Each storyRange In ActiveDocument.StoryRanges
' Process each story
Do
' Loop through all character styles in the story
For Each charStyle In ActiveDocument.Styles
If charStyle.Type = wdStyleTypeCharacter Then
' Loop through all ranges with the current character style
Set charRange = storyRange.Duplicate
With charRange.Find
.ClearFormatting
.Style = charStyle
.Forward = True
.Wrap = wdFindStop
.Format = True
.Execute
Do While .Found
' Exclude superscript within footnote references
If Not (Not supStyle Is Nothing And charStyle.NameLocal = "Superscript" And charRange.InRange(supStyle.Range)) Then
' Remove the character style
charRange.CharacterStyle = ""
End If
' Find the next occurrence
.Execute
Loop
End With
End If
Next charStyle
' Move to the next linked story range
Set storyRange = storyRange.NextStoryRange
Loop Until storyRange Is Nothing
Next storyRange
End Sub

[Aussiebear]

or... maybe this effort;



Sub RemoveCharacterStylesFromFootnotesExceptSuperscriptInFootnoteReferences()
Dim footnoteRange As Range
Dim charStyle As Style
Dim charRange As Range
Dim supRange As Range
Dim supStyle As Style
' Set the style for superscript within footnote references
On Error Resume Next
' Handle potential error if style doesn't exist
Set supStyle = ActiveDocument.Styles("Footnote Reference")
On Error GoTo 0
If supStyle Is Nothing Then
MsgBox "Footnote Reference style not found. Macro will remove all character styles from footnotes.", vbExclamation
End If
' Loop through all footnotes
For Each footnoteRange In ActiveDocument.Footnotes
' Loop through all character styles in the footnote
For Each charStyle In ActiveDocument.Styles
If charStyle.Type = wdStyleTypeCharacter Then
' Loop through all ranges with the current character style
Set charRange = footnoteRange.Range.Duplicate
With charRange.Find
.ClearFormatting
.Style = charStyle
.Forward = True
.Wrap = wdFindStop
.Format = True
.Execute
Do While .Found
' Exclude superscript within footnote references
If Not (Not supStyle Is Nothing And charStyle.NameLocal = "Superscript" And charRange.InRange(supStyle.Range)) Then
' Remove the character style
charRange.CharacterStyle = ""
End If
' Find the next occurrence
.Execute
Loop
End With
End If
Next charStyle
Next footnoteRange
End Sub