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
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