Microsoft Office Forums - View Single Post - [Solved] MAcro to List all the Font & its size in a word document

shaukat74 · 01-16-2013, 11:43 AM

I need a Macro to list all the font name & its size in a word file - & list them
This is required as per the Audit by the Project
Can the below Macro be fine tuned for the same. The Below Macro list all the fonts other than arial & give me the page number where the font is located in the 300 page document. I need to modify the macro to give me all the fonts & its size in the new macro

Code:

Sub FindAllFonts()      
    Dim lWhichFont As Long      
    Dim sTempName As String      
    Dim sBuffer As String      
    Dim newDoc As Document Dim p As Long      
    Application.ScreenUpdating = False      
    For lWhichFont = 1 To FontNames.Count          
        sTempName = FontNames(lWhichFont)          
        If sTempName <> "Arial" Then              
            p = FindThisFont(sTempName)              
            If p > 0 Then sBuffer = sBuffer & sTempName & " on page " & p & vbCrLf
        End If 
    End If 
Next lWhichFont 
Set newDoc = Documents.Add  
Selection.TypeText Text:=sBuffer 
Application.ScreenUpdating = True  
End Sub 
 
Function FindThisFont(sName As String) As Long      
    Selection.HomeKey Unit:=wdStory      
    With Selection.Find          
        .Text = ""          
        .ClearFormatting         
        .Font.Name = sName          
        .Forward = True          
        .Format = True 
        If .Execute Then FindThisFont = Selection.Information(wdActiveEndPageNumber)          
    End If      
End With  
End Function