Word VBA - Applying alternate font color via styles does not work with text that has direct formatting (of font color) applied

Question

I have created a template (one of a series of many similar templates) that will be distributed to multiple users to be used to create transcripts (of audio and digital files). The transcript includes a number of styles that will be used exclusively to format the text.

The template includes a series of macros that temporarily changes the font colors of each of the custom styles in order to aid in a quick proofing of the format, and then another macro to change them all back to the black/auto font color.

As long as there is no direct formatting of font colors within any of the custom styles, this process works swimmingly. However, I am contemplating the possibility that some users might opt to select all the text and use the direct formatting method to restore the temp-colored fonts to black. If they do this, it renders all of the color-centric macros (change to a color, change back to black) useless.

This could be very problematic because the transcripts produced by these users will ultimately be submitted to a subcontractor, who may wish to employ the color-centric macros herself for additional proofing before submitting the final transcript to her client. But they will no longer work if the user has applied direct formatting of font colors.

I was able to remove the direct-formatting font color, both manually and via a macro, by using the "clear formatting" option, then reapplying the style. But that is not a practical solution for this conundrum because any given paragraph might contain other attributes such as bold, underlining, or italicized text, which is lost when the "clear formatting" option is applied. I contemplated applying character styles to those attributes, but there is no way I can guarantee that a user will use them, so there is still a risk of losing the attributes when trying to deal with the potential font color issue.

I have conducted exhaustive experiments in Word and searched through the help files as well as extensively on Google, and I cannot find any information that facilitates removing ONLY the direct formatting relative to font colors while leaving other direct formatting attributes intact so that I can employ the macros to change the font colors within the styles.

Am I missing the forest for the trees and going about this all wrong? Or is there one little element lacking in my macro code that would address this problem?

I have copied the two main color-centric macros below. There are actually 8 additional macros that are part of this same category, because I'm also giving the user the option to change the font color in individual styles as well as the QUESTION and ANSWER style together (while not changing any other styles). But they are just identical snippets of the code shown below, paired down to deal with individual styles.

Thanks in advance for any help!

Change all the styles to a different color:

    Sub STYLES_AllColors()

        With ActiveDocument.Styles("#CENTERED (DS)")
                .Font.ColorIndex = wdGray50
        End With

        With ActiveDocument.Styles("#FLUSH LEFT (DS)")
                .Font.ColorIndex = wdDarkYellow
        End With

        With ActiveDocument.Styles("#PARENTHETICAL")
                .Font.ColorIndex = wdViolet
        End With

        With ActiveDocument.Styles("#QUESTION (looped)")
                .Font.ColorIndex = wdRed
        End With

        With ActiveDocument.Styles("#ANSWER (looped)")
                .Font.ColorIndex = wdBlue
        End With

        With ActiveDocument.Styles("#QA2 (continuing paragraph)")
                .Font.ColorIndex = wdTurquoise
        End With

        With ActiveDocument.Styles("#QA (plain format)")
                .Font.ColorIndex = wdDarkRed
        End With

    End Sub

Change all the styles back to black/auto:

    Sub STYLES_AllBlack()

        With ActiveDocument.Styles("#CENTERED (DS)")
                .Font.Color = wdColorAutomatic
        End With

        With ActiveDocument.Styles("#FLUSH LEFT (DS)")
                .Font.Color = wdColorAutomatic
        End With

        With ActiveDocument.Styles("#PARENTHETICAL")
                .Font.Color = wdColorAutomatic
        End With

        With ActiveDocument.Styles("#QUESTION (looped)")
                .Font.Color = wdColorAutomatic
        End With

        With ActiveDocument.Styles("#ANSWER (looped)")
                .Font.Color = wdColorAutomatic
        End With

        With ActiveDocument.Styles("#QA2 (continuing paragraph)")
                .Font.Color = wdColorAutomatic
        End With

        With ActiveDocument.Styles("#QA (plain format)")
                .Font.Color = wdColorAutomatic
        End With

    End Sub

Answer 1

I may have found the answer, or at least a suitable workaround for now.

After more experimenting, it seems that even if direct formatting (of font colors) has been applied to the text, the macro-generated font changes will work if I use the find/replace method to search for the individual styles and change the font, rather than applying the font changes directly to the style (within the macro), as I was doing. That results in a lot of extra formatting styles, but I can provide the users with instructions and tools to prevent and/or eliminate that clutter on the Formatting Pane.

So unless someone comes along with a more elegant solution, that's what I'll go with for now. Here is a snippet of the code for an individual style. I will have to expand it to cover all of the styles, and create a companion macro to remove all the colors.

     Selection.Find.ClearFormatting
        Selection.Find.Style = ActiveDocument.Styles("#QUESTION (looped)")
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Style = ActiveDocument.Styles( _
            "#QUESTION (looped)")
        With Selection.Find.Replacement.Font
        .Color = wdColorRed
        End With
        With Selection.Find
            .Text = ""
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
        End With
        Selection.Find.Execute Replace:=wdReplaceAll

Answer 2

I have a similar problem when I use EndNote to manage a bibliography. It remakes the style every update. I run a macro that calls several others to put in links and optional spaces. I think that the subroutine I run to cleanup the EndNote Bibliography paragraph style and paragraph instances may provide a view to the scheme that I use.

I have included that code below, it also will cut down on the explosion of Direct Styles.

I first make sure that the style itself is what I want. Then I go to each instance and set it to the same. Now, these are paragraphs, the character style is similar. If you are still watching this question, let me know, and I will write up the character style code. It can use a subroutine that just runs through an array of styles and colors.

Private Sub EndNoteStyleFixup(d As Document, r As Range)
'
' EndNoteBibliographyStyleFix Macro
'
'
    Dim ENStyle As Style
    Dim p As Paragraph
    Dim pCnt As Long

    Set ENStyle = Nothing
    On Error Resume Next
    Set ENStyle = d.Styles("EndNote Bibliography")
    On Error GoTo 0
    If ENStyle Is Nothing Then
        'done
    Else
        pCnt = 0
        With ENStyle
           .Font.name = "Times New Roman"
           .Font.Size = 10.5
           With .ParagraphFormat
                .LeftIndent = InchesToPoints(0.25)
                .RightIndent = InchesToPoints(0)
                .SpaceBefore = 0
                .SpaceBeforeAuto = False
                .SpaceAfter = 2
                .SpaceAfterAuto = False
                .LineSpacingRule = wdLineSpaceSingle
                .Alignment = wdAlignParagraphLeft
                .WidowControl = True
                .KeepWithNext = False
                .KeepTogether = False
                .PageBreakBefore = False
                .Hyphenation = True
                .FirstLineIndent = InchesToPoints(-0.25)
                .OutlineLevel = wdOutlineLevelBodyText
                .CharacterUnitLeftIndent = 0
                .CharacterUnitRightIndent = 0
                .CharacterUnitFirstLineIndent = 0
                .LineUnitBefore = 0
                .LineUnitAfter = 0
                .MirrorIndents = False
                .TextboxTightWrap = wdTightNone
                doEndNoteTabs .TabStops
            End With
            .NoSpaceBetweenParagraphsOfSameStyle = False
            .AutomaticallyUpdate = False
            .BaseStyle = "Normal"
            .NextParagraphStyle = "EndNote Bibliography"
        End With
        For Each p In r.Paragraphs
            If ENStyle = p.Style Then
                p.Range.Select
                With p.Range
                        .Font.name = "Times New Roman"
                        .Font.Size = 10.5
                    With .ParagraphFormat
                        .LeftIndent = InchesToPoints(0.25)
                        .RightIndent = InchesToPoints(0)
                        .SpaceBefore = 0
                        .SpaceBeforeAuto = False
                        .SpaceAfter = 2
                        .SpaceAfterAuto = False
                        .LineSpacingRule = wdLineSpaceSingle
                        .Alignment = wdAlignParagraphLeft
                        .WidowControl = True
                        .KeepWithNext = False
                        .KeepTogether = False
                        .PageBreakBefore = False
                        .Hyphenation = True
                        .FirstLineIndent = InchesToPoints(-0.25)
                        .OutlineLevel = wdOutlineLevelBodyText
                        .CharacterUnitLeftIndent = 0
                        .CharacterUnitRightIndent = 0
                        .CharacterUnitFirstLineIndent = 0
                        .LineUnitBefore = 0
                        .LineUnitAfter = 0
                        .MirrorIndents = False
                        .TextboxTightWrap = wdTightNone
                        doEndNoteTabs .TabStops
                    End With
                End With
                p.Style = ENStyle
            End If
        Next p
    End If
End Sub