Check for font name and size

[David Turner]

In some texts I receive, umlauts have a different font (size and/or name)
from the surrounding or underlying text (in "über" for instance, "ü" could be
in Times and the rest in Arial). What would be the faster way to check for
this and correct it if necssary (set "ü" to Arial). I've got this far but
there's no doubt a better way:

Sub CheckWordFont()

Dim rPrg As Paragraph
Dim rWrd As Range
Dim dupFont As Font

For Each rPrg In ActiveDocument.Paragraphs
If rPrg.Range.Font.Name = "" Or rPrg.Range.Font.Size = 9999999 Then
For Each rWrd In rPrg.Range.Words
If rWrd.Font.Name = "" Or rWrd.Font.Size = 9999999 Then
Set dupFont = rWrd.Font.Duplicate
rWrd.Font.Reset
rWrd.Font = dupFont
End If
Next
End If
Next

End Sub

The trouble is that if I just do a reset font on the offending word, I would
have to check for all the other font attributes (italic, etc.) first and if I
try and duplicate the font before resetting, the umlaut is not reset. I guess
I would have to go down to character level and check the font of the
surrounding letters in the word?
Any help gratefully accepted.

David

 

[David Turner]

Finally managed to sort it by myself. Probably a bit laborius, but seems to
work.

Sub CheckWordFont()

Dim rPrg As Paragraph
Dim rWrd As Range
Dim rChr As Range
Dim oSty As Style

For Each rPrg In ActiveDocument.Paragraphs
If rPrg.Range.Font.Hidden = False Then
If rPrg.Range.Font.Name = "" Or rPrg.Range.Font.Size = 9999999 Then
For Each rWrd In rPrg.Range.Words
If rWrd.Font.Name = "" Or rWrd.Font.Size = 9999999 Then
For Each rChr In rWrd.Characters
Set oSty = ActiveDocument.Styles(wdStyleNormal)
If oSty.Font.Name <> Selection.Paragraphs(1).Style Then
oSty.Font.Name = Selection.Font.Name
End If
If rChr.Font.Name <> oSty.Font.Name Then
rChr.Font.Name = oSty.Font.Name
End If
If oSty.Font.Size <> Selection.Paragraphs(1).Style Then
oSty.Font.Size = Selection.Font.Size
End If
If rChr.Font.Size <> oSty.Font.Size Then
rChr.Font.Size = oSty.Font.Size
End If
Next
End If
Next
End If
End If
Next

End Sub

David Turne