Reset character while retaining/restoring font style

[David Turner]

Word documents often contain lots of so-called smart tags which show up in a
translation program I use as junk placeholder codes({1}, {2}, {3}, etc.)
between, and sometimes even in the middle of, words.
One way of getting rid of these codes is to do a Reset character (control +
spacebar) on the whole document.
Unfortunately, this also removes character formatting (bold, italic,
underline, font colour, size, etc.).
I tried to expand on some code examples by Helmut Weber to do a reset font
while retaining charactering formatting.
The macro seems to work quite well (apart from underline which for some
reason I had to do at individual character level to avoid spaces between word
being underlined when the formatting is restored).
I would now like to try and improve it so as to retain (restore) any text
formatted using character styles as well as direct formatting and would be
very grateful for any tips or examples.

Here’s the code:

Sub ResetDupFont4()

Application.ScreenUpdating = False

Dim rPrg As Paragraph ' a paragraph

Dim rSnt As Range ' a sentence

Dim rWrd As Range ' a word

Dim rChr As Range ' a character

Dim dupFont As Font ' font duplicate in range

For Each rPrg In ActiveDocument.Paragraphs

If rPrg.Range.Font.Bold <> 9999999 _
And rPrg.Range.Font.Italic <> 9999999 _
And rPrg.Range.Font.Underline <> 9999999 _
And rPrg.Range.Font.SmallCaps <> 9999999 _
And rPrg.Range.Font.AllCaps <> 9999999 _
And rPrg.Range.Font.Outline <> 9999999 _
And rPrg.Range.Font.Emboss <> 9999999 _
And rPrg.Range.Font.Shadow <> 9999999 _
And rPrg.Range.Font.Engrave <> 9999999 _
And rPrg.Range.Font.strikethrough <> 9999999 _
And rPrg.Range.Font.DoubleStrikeThrough <> 9999999 _
And rPrg.Range.Font.Superscript <> 9999999 _
And rPrg.Range.Font.Subscript <> 9999999 _
And rPrg.Range.Font.Hidden <> 9999999 _
And rPrg.Range.Font.Color <> 9999999 _
And rPrg.Range.Font.Size <> 9999999 _
And rPrg.Range.Font.Name <> "" Then

Set dupFont = rPrg.Range.Font.Duplicate
rPrg.Range.Font.Reset
rPrg.Range.Font = dupFont

ElseIf rPrg.Range.Font.Bold = 9999999 _
Or rPrg.Range.Font.Italic = 9999999 _
Or rPrg.Range.Font.Underline = 9999999 _
Or rPrg.Range.Font.SmallCaps = 9999999 _
Or rPrg.Range.Font.AllCaps = 9999999 _
Or rPrg.Range.Font.Outline = 9999999 _
Or rPrg.Range.Font.Emboss = 9999999 _
Or rPrg.Range.Font.Shadow = 9999999 _
Or rPrg.Range.Font.Engrave = 9999999 _
Or rPrg.Range.Font.Superscript = 9999999 _
Or rPrg.Range.Font.Subscript = 9999999 _
Or rPrg.Range.Font.Hidden = 9999999 _
Or rPrg.Range.Font.Color = 9999999 _
Or rPrg.Range.Font.Size = 9999999 _
Or Not rPrg.Range.Font.Name <> "" Then

For Each rSnt In rPrg.Range.Sentences

If rSnt.Font.Bold <> 9999999 _
And rSnt.Font.Italic <> 9999999 _
And rSnt.Font.Underline <> 9999999 _
And rSnt.Font.SmallCaps <> 9999999 _
And rSnt.Font.AllCaps <> 9999999 _
And rSnt.Font.Outline <> 9999999 _
And rSnt.Font.Emboss <> 9999999 _
And rSnt.Font.Shadow <> 9999999 _
And rSnt.Font.Engrave <> 9999999 _
And rSnt.Font.strikethrough <> 9999999 _
And rSnt.Font.DoubleStrikeThrough <> 9999999 _
And rSnt.Font.Superscript <> 9999999 _
And rSnt.Font.Subscript <> 9999999 _
And rSnt.Font.Hidden <> 9999999 _
And rSnt.Font.Color <> 9999999 _
And rSnt.Font.Size <> 9999999 _
And rSnt.Font.Name <> "" Then

Set dupFont = rSnt.Font.Duplicate
rSnt.Font.Reset
rSnt.Font = dupFont

ElseIf rSnt.Font.Bold = 9999999 _
Or rSnt.Font.Italic = 9999999 _
Or rSnt.Font.Underline = 9999999 _
Or rSnt.Font.SmallCaps = 9999999 _
Or rSnt.Font.AllCaps = 9999999 _
Or rSnt.Font.Outline = 9999999 _
Or rSnt.Font.Emboss = 9999999 _
Or rSnt.Font.Shadow = 9999999 _
Or rSnt.Font.Engrave = 9999999 _
Or rSnt.Font.Superscript = 9999999 _
Or rSnt.Font.Subscript = 9999999 _
Or rSnt.Font.Hidden = 9999999 _
Or rSnt.Font.Color = 9999999 _
Or rSnt.Font.Size = 9999999 _
Or Not rSnt.Font.Name <> "" Then

For Each rWrd In rSnt.Words

If rWrd.Font.Bold <> 9999999 _
And rWrd.Font.Italic <> 9999999 _
And rWrd.Font.Underline = False _
And rWrd.Font.SmallCaps <> 9999999 _
And rWrd.Font.AllCaps <> 9999999 _
And rWrd.Font.Outline <> 9999999 _
And rWrd.Font.Emboss <> 9999999 _
And rWrd.Font.Shadow <> 9999999 _
And rWrd.Font.Engrave <> 9999999 _
And rWrd.Font.strikethrough <> 9999999 _
And rWrd.Font.DoubleStrikeThrough <> 9999999 _
And rWrd.Font.Superscript <> 9999999 _
And rWrd.Font.Subscript <> 9999999 _
And rWrd.Font.Hidden <> 9999999 _
And rWrd.Font.Color <> 9999999 _
And rWrd.Font.Size <> 9999999 _
And rWrd.Font.Name <> "" Then

Set dupFont = rWrd.Font.Duplicate
rWrd.Font.Reset
rWrd.Font = dupFont

ElseIf rWrd.Font.Bold = 9999999 _
Or rWrd.Font.Italic = 9999999 _
Or rWrd.Font.Underline = True Or 9999999 _
Or rWrd.Font.SmallCaps = 9999999 _
Or rWrd.Font.AllCaps = 9999999 _
Or rWrd.Font.Outline = 9999999 _
Or rWrd.Font.Emboss = 9999999 _
Or rWrd.Font.Shadow = 9999999 _
Or rWrd.Font.Engrave = 9999999 _
Or rWrd.Font.strikethrough = 9999999 _
Or rWrd.Font.DoubleStrikeThrough = 9999999 _
Or rWrd.Font.Superscript = 9999999 _
Or rWrd.Font.Subscript = 9999999 _
Or rWrd.Font.Hidden = 9999999 _
Or rWrd.Font.Color = 9999999 _
Or rWrd.Font.Size = 9999999 _
Or Not rWrd.Font.Name <> "" Then

For Each rChr In rWrd.Characters

Set dupFont = rChr.Font.Duplicate
rChr.Font.Reset
rChr.Font = dupFont

Next
End If
Next
End If
Next
End If
Next

End Sub


I tried to add this code for character styles, but it doesn’t seem to work
very well:

..
..
..
And rPrg.Range.Style.Type <> wdStyleTypeCharacter Then

Set dupFont = rPrg.Range.Font.Duplicate
rPrg.Range.Font.Reset
rPrg.Range.Font = dupFont

ElseIf rPrg.Range.Style.Type = wdStyleTypeCharacter Then
rPrg.Range.Select
For Each rChr In Selection.Characters
Set charSty = rChr.Style
Set paraSty = rChr.Paragraphs(1).Style
If charSty <> paraSty Then
rChr.Font.Reset
rChr.Style = charSty
Else
rChr.Font.Reset
End If
Next rChr

 

[Greg Maxey]

Have you tried something like:

Sub ScratchMacro()
ActiveDocument.RemoveSmartTags
End Sub

 

[David Turner]

Yes, as well as:

..AcceptAllRevisions
..TrackRevisions = False
..AutoHyphenation = False
..HyphenateCaps = False
..EmbedSmartTags = False
..EmbedLinguisticData =Flase
..NoProofing = False
..LanguageID = wdEnglishUS

etc.

But Reset character seems to be the only dependable way of removing all junk
other than saving as as a text file.

Thanks,
David