2015-09-30

Getting the Fonts in Use in a Word Document

Word does not provide an easy way to get a list of the fonts in use inside the document. Here is a VBA macro that will provide that list. In word, press Alt+F11, Select Insert Module from the menu, and paste the code below. Then from the View ribbon, click Macros, select XocListFonts from the list, then click Run. It will show a MessageBox with the names of all the typefaces in use inside the document. When you save the document, you will need to save it as a Macro Enabled Document, otherwise the code will be removed.

Public Sub XocListFonts()
    On Error GoTo ErrorHandler
    Dim rngStory As Range
    Dim rngChar As Range
    Dim strsFontNames As Collection
    Dim strFontOld As String
    Dim strFontCur As String
    Dim strFontName As String
    Dim objFontName As Variant
    Dim Number As Integer
    Dim strFonts As String
    
    Set strsFontNames = New Collection
    For Each rngStory In ActiveDocument.StoryRanges
        strFontOld = ""
        If rngStory.End > 1 Then
            Set rngChar = rngStory.Characters(1)
            Do
                strFontCur = rngChar.Font.Name
                If strFontCur <> strFontOld Then
                    strFontOld = strFontCur
                    
                    ' This causes a runtime error if the font doesn't exist
                    objFontName = strsFontNames.Item(strFontCur)
                End If
                rngChar.MoveStart wdCharacter, 1
                rngChar.MoveEnd wdCharacter, 1
            Loop Until rngChar.End = rngStory.End
        End If
    Next rngStory
    
    For Each objFontName In strsFontNames
        strFonts = strFonts & objFontName & vbCrLf
    Next objFontName
    MsgBox strFonts
Exit Sub
ErrorHandler:
    Number = Err.Number
    Select Case Number
        Case 5 'Invalid Procedure Call
            strsFontNames.Add strFontCur, strFontCur
            Resume Next
        Case Else
            MsgBox "Unexpected Error #" & Number & vbCrLf & Err.Description
    End Select
End Sub

An alternate way to get a list is to save the document as a PDF file. Then open the PDF file in Adobe Reader. From the File menu, select Properties. Then click the fonts tab. Adobe is a little more explicit about the fonts, differentiating Bold and Italic fonts from the normal font.

No comments :

Post a Comment