Find and Replace missing font (font substitution problem)

[revstead]

I am trying to programmatically convert all references in a document of one
fontname to another, in order to replace a missing font. This code works
fine ... but only if the 'missing' font ("SuperHebrew") is in fact installed.

For Each rngStory In ActiveDocument.StoryRanges
With rngStory.Find
.ClearFormatting
.Font.Name = "SuperHebrew"

Do While .Execute(FindText:="", Forward:=True) = True
With .Parent
HebrewString = .Text
HebrewString = ConvertSupHebToCCAT(HebrewString)
HebrewString = ConvertCCATToUnicode(HebrewString, "Vowels")
If HebrewString <> "" Then .Text = HebrewString
.Font.Name = "Ezra SIL"
.Move Unit:=wdWord, Count:=1
End With
Loop
End With
Next rngStory


However, if SuperHebrew is NOT installed (which is the situation I am trying
to handle <grin>) , then MSWord Font Substitution kicks in, and remaps the
font to a different font (in this case "Default"). The side effect of this
is that I can no longer reference the missing font by its orginal name, and I
cannot work out what name I should use the code does not find anything to
change. I have tried changing to ...
font.name = "Arial" 'Ariel is my Default font
font.name = "(Default)"
font.name = "(Default) SuperHebrew" ' this is how is displays in manual
Search & Replace

None of these work. Any ideas?

Cheers
revstead

 

[Russ]

This Google Groups search yielded this quote from Jay Freedman:
http://snipurl.com/10pv9
---------------------------------------
In both 2000 and 2003, you can see *and change* the font substitution by
going to Tools > Options > Compatibility and clicking the Font Substitution
button. That dialog will show you any fonts used in the current document
that aren't installed. There's also a dropdown that lets you choose which
installed font will display in place of the selected missing font.

That substitution assignment is specific to the current machine, not the
document.

 

[revstead]

Dear Russ,

Thanks for this. It didn't exactly answer my question, but it put me on the
right track. The answer turned out to be in using Application.SubstituteFont
to effectively cancel the automatic font substitution! (see the first line
of the code below)

Thanks for you help
revstead


Working code...

Application.SubstituteFont UnavailableFont:="SuperHebrew",
_SubstituteFont:="SuperHebrew"

For Each rngStory In ActiveDocument.StoryRanges
With rngStory.Find
.ClearFormatting
.Font.Name = "SuperHebrew"

Do While .Execute(FindText:="", Forward:=True) = True
With .Parent
HebrewString = .Text
HebrewString = ConvertSupHebToCCAT(HebrewString)
HebrewString = ConvertCCATToUnicode(HebrewString, "Vowels")
If HebrewString <> "" Then
If HebrewString <> Chr$(13) Then .Text = HebrewString
End If
.Font.Name = "Ezra SIL"
.Move Unit:=wdWord, Count:=1
End With
Loop
End With
Next rngStory