word macro- font checking

[drkestrel]

Is it possible to list all the fonts used in the

ActiveDocument

. Not surprisingly, if you do a

Selection.Font.Name

where

Selection

contains more than one font, it doesn't quite work Can't find any collection objects that store the list of fonts used. I guess I could do

Selection.MoveRight Unit:=wdCharacter, Count:=1

in a loop and keep
track of the fonts used. But it's a bit tedious, and also does not go into different headers/footers/style definitions, etc...

 

[TonyJollans]

Hi drkestrel,

I took the opportunity offered by your question to do something I’ve been meaning to do for some time and have a play with the Word Object model. There are plenty people out there who know Word far better than I do but as no-one has come forward with anything I offer up the results of my investigations for what they’re worth.

Despite the fact that Word maintains a list of used fonts (use a text editor to look at a document and you will see it) there doesn’t seem, as you say, to be any way to access it via VBA and the only alternative I can see is the one you suggest yourself of spinning through the text; you can, however, make it a little less tedious by using text elements without selecting them.

Documents consist of a variety of elements. At the top of the hierarchy there are stories; the main story is the body of the document not including headers, footers, footnotes and the like (if you want details of the fonts used in these you’ll need to examine them separately). Stories consist of paragraphs, paragraphs consist of sentences, sentences consist of words and words consist of characters (all of these terms appear to have their normal English meanings). It is worth noting that, for example, paragraphs also consist of characters – it is not necessary to work through every level.

The code below loops through all the paragraphs in a document. If a paragraph has a single font we save it; if it doesn’t then we look at each sentence within the paragraph. Again, if the sentence has a single font it is saved, otherwise we look at words and only if a word has multiple fonts is it necessary to look at individual characters (I believe a single character must have a single font).

A couple of points before the code – (1) a font is a property of a range (loosely translated from Word this means a block of text) but a paragraph is a special type of block of text which is not itself a range so we need to use the range which is the paragraph to get the font (does that make sense?) – (2) I chose to use a Collection to keep track of the fonts because I could easily avoid duplicates by ignoring errors when adding to it, but there are other ways.

OK - here it is - hope it helps -

Sub BuildFontList()

Dim pParagraph As Paragraph
Dim rParagraph As Range
Dim rSentence As Range
Dim rWord As Range
Dim rCharacter As Range

Dim FontList As New Collection

For Each pParagraph In ActiveDocument.Paragraphs
  Set rParagraph = pParagraph.Range
    
  If rParagraph.Font.Name = "" Then
    For Each rSentence In rParagraph.Sentences
        
      If rSentence.Font.Name = "" Then
        For Each rWord In rSentence.Words
                              
          If rWord.Font.Name = "" Then
            For Each rCharacter In rWord.Characters
              SaveFontName FontList, rCharacter
            Next
          Else
            SaveFontName FontList, rWord
          End If
          
        Next
      Else
        SaveFontName FontList, rSentence
      End If
      
    Next
  Else
    SaveFontName FontList, rParagraph
  End If
  
Next

For Each FontName In FontList
    MsgBox FontName
Next

End Sub


Sub SaveFontName(cCollection As Collection, rRange As Range)
        
    On Error Resume Next
    cCollection.Add Item:=rRange.Font.Name, Key:=rRange.Font.Name
    On Error GoTo 0

End Sub

Enjoy,
Tony

 

[RobBroekhuis]

Here's another approach, which takes the list of fonts and searches for each one of them in your document. This one may be faster than Tony's for very long documents, and slower for shorter documents. Try both, and see which works best for you.

Sub FindFonts()
Dim i As Integer
For i = 1 To FontNames.Count
Selection.HomeKey wdStory
With Selection.Find
.ClearFormatting
.Font.Name = FontNames(i)
.Execute
If Selection.Font.Name = FontNames(i) Then
msgbox FontNames(i)
End If
End With
Next i
End Sub
Rob

 

[drkestrel]

Thanks Rob but FontNames applies to Word.Application and not to Document object!!
Tony, your method seems to be working Many Thanks,

 

[RobBroekhuis]

Yes, FontNames applies to Word.application. The sub takes each of the font names known to Word, and sees if it is present in the application. Did you try it?
Rob

 

[TonyJollans]

Rob,

I like it. I hadn't thought to look at it that way.

However FontNames only gives the fonts currently available and a document created on another machine, or at another time, may contain other fonts which won't get picked up.

Enjoy,
Tony

 

[RobBroekhuis]

Tony,
I was wondering about that. Of course I don't have the means of testing it (working on a single machine). Don't the fonts that are unknown on the current machine get automatically translated to a "close relative" when the Word document is loaded?
Rob

 

[TonyJollans]

Rob,

I'm afraid I don't know how it works. You are right as far as displaying them on screen (and printing them) goes, but the fonts are not available for selection in the document, nor do they exist in the FontNames object, at least not in my (Word 2000) version. Embedding the (TrueType) font in the document causes correct display but still does not make it available for selection - I can't find anything else to try.

Enjoy,
Tony