Rich Text Content Contol retain Style Setting when whole document is changed

[ciresuark]

Hello! I am working with a letter with various rich text and date pickers. The end user currently highlights the entire letter and chooses the correct font and size. There is one rich text content control I would like to have retain the style that is set up for it. When the whole document is selected the content control is included with it.



My goal is to write a macro to have the user click a button to highlight the whole document for them and change the font and size without having to edit this one content control.

Any help is appreciated.

[macropod]

The correct way to do this is not to select the whole document and override the font attributes of the Style(s) used, but to modify the Style definitions. Accordingly, if you assign one Style to the whole of the document, except for the content control(s) of interest and another Style to the content control(s) of interest, all that would be needed is to change that one Style's definition. If, for example, everything except the content control is formatted with Word's 'Normal' Style, you could use a macro like:

Sub Demo()
Dim Fnt As Font
Set Fnt = ActiveDocument.Styles("Normal").Font
With Application.Dialogs(wdDialogFormatDefineStyleFont)
  If .Show = -1 Then
    Fnt.AllCaps = .AllCaps
    Fnt.Animation = .Animations
    Fnt.Bold = .Bold
    Fnt.BoldBi = .BoldBi
    Fnt.Color = .ColorRGB
    Fnt.DiacriticColor = .DiacColor
    Fnt.DoubleStrikeThrough = .DoubleStrikeThrough
    Fnt.Emboss = .Emboss
    Fnt.Engrave = .Engrave
    Fnt.Hidden = .Hidden
    Fnt.Italic = .Italic
    Fnt.Kerning = .Kerning
    Fnt.Name = .Font
    Fnt.Outline = .Outline
    Fnt.Position = Selection.Font.Position
    Fnt.Scaling = Selection.Font.Scaling
    Fnt.Size = .Points
    Fnt.Shadow = .Shadow
    Fnt.SmallCaps = .SmallCaps
    Fnt.StrikeThrough = .StrikeThrough
    Fnt.Superscript = .Superscript
    Fnt.Subscript = .Subscript
    Fnt.Spacing = Selection.Font.Spacing
    Fnt.Underline = .Underline
    Fnt.UnderlineColor = .UnderlineColor
  End If
End With
End Sub

As you can see, this allows you to capture and update far more than just a change to the name and point size.