UnavailableFonts - VBA


I would like to display all the substituted fonts thru a msgbox.

I tried Application.Dialogs.Item(wdDialogFontSubstitution).unavailablefont. But it gives me the name of the first substituted font, but not the others, i.e. if there are 4 unavailable fonts, the abovesaid function returns only the first unavailable font. How can I get the list of all unavailable fonts?

Who is Participating?
Computer101Connect With a Mentor Commented:
PAQed, with points refunded (250)

E-E Admin
One solution could be to make a list of all installed fonts and compare it to the list of fonts in the document.

The list of all fonts is contained in Application.FontNames

The list of fonts contained in the document is appearently not this easy to retrieve. http://www.tribbs.co.uk/showtip.php?myID=29&start=6 suggest to iterate through each character and check its font - this is certainly feasible, but obviously extremly slow.

Any other ideas?
vi_srikanthAuthor Commented:
Thats how I have right now. But, I want to do that thru wdDialogFontSubstitution. Is there any way?
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Anne TroyEast Coast ManagerCommented:
Try to get something out of this...

Private Sub btnFonts_Click()
End Sub
Public Sub main()
  Dim sMsg As String
  sMsg = GetFonts(ThisDocument)
  MsgBox "The fonts in this document are:" & vbNewLine & vbNewLine & sMsg
  MsgBox "The following fonts are used in this document," & vbNewLine & "but are not installed on this PC:" & vbNewLine & CompareFonts(sMsg)
End Sub

Private Function GetFonts(ByVal oDocument As Document) As String
  Dim oParagraph As Paragraph
  Dim i As Integer
  Dim oWord As Words
  Dim sFontType As String
  Dim sMsg As String
  For Each oParagraph In oDocument.Paragraphs
    For i = 1 To oParagraph.Range.Characters.Count
      sFontType = oParagraph.Range.Characters(i).Font.Name
      If InStr(1, sMsg, sFontType) = 0 Then
        sMsg = sMsg & sFontType & vbNewLine
      End If
  GetFonts = sMsg
End Function

Private Function CompareFonts(ByVal oFonts As String) As String
Dim vFont As Variant
Dim sMsg As String
Dim xFont
Dim i As Long
Dim allFonts As String
For Each vFont In FontNames
allFonts = allFonts & vbNewLine & vFont
Next vFont
xFont = Split(oFonts, vbNewLine)
For i = 0 To UBound(xFont)
If InStr(allFonts, xFont(i)) = 0 Then
sMsg = sMsg & vbNewLine & xFont(i)
End If
Next i
CompareFonts = sMsg
End Function

it looks like the only shortcut would be to use the use SelectCurrentFont method instead of selecting each individual character as shown in the sample above from Dreamboat.

I have not yet found a way to extract the elements from the list box. An option might be to display the dialog and use some clever API programming to extract the list elements; however, this would require some external programs (i.e., not Word VBA).

Still looking into it, but I'm not very confident...

vi_srikanthAuthor Commented:
Hi Dreamboat,

As I've said earlier,  I want to do that thru wdDialogFontSubstitution. The Application.Dialogs.Item(wdDialogFontSubstitution).unavailablefont displays only the first font, but, how can i get the other unavailable fonts?

Hi  fulscher,

When u've got the solution pls. let me know.

Anne TroyEast Coast ManagerCommented:
What do you mean, the first available font?

When I run that code, it tells me ALL the fonts that are unavailable on the PC, not just the *first*.

I created a file.
I set two fonts: Century Times and Univers

BOTH fonts showed as unavailable.
Isn't that what you want?
Anne TroyEast Coast ManagerCommented:
No one has discussed version here...

And, I've finally got the code loaded with a sample file:
Sorry, no news yet. I'm still not sure whether this can be solved using the wdDialogFontSubstitution dialog - MS obviously did not intend you to make use of the info provided there :-(

vi_srikanthAuthor Commented:
> When I run that code, it tells me ALL the fonts that are unavailable on the PC, not just the *first*.

I want to collect the names of the unavailable fonts thru wdDialogFontSubstitution. At present I have a code like what u've posted, but, I would like to use the Word's FontSubstitution information itself. More than that, I want to know the name of the substituted font. I use Word 2000.
Anne TroyEast Coast ManagerCommented:
Refund and PAQ. I don't think we ever figured out what the asker really wanted.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.