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.

1. Select the first footnote reference in the body of the document
2. Home, Editing, Select, Select Text with similar formatting
3. Ctrl spacebar
4. 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/...ormatting.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