Solved: finding missing fonts in word doc

[senthilkumar]

Hai all,

I am in need of finding the missing fonts and the list of fonts used in the document.

Thanks,
Senthil.

[gwkenny]

lol

You need to be a bit more clear.

If the font is not on the list of fonts, is that considered missing? If so, that's one helluva lot of fonts!!!

If the font is on the list of fonts, but not in the document, is that a missing font? You are aware that most documents only utilize 3 or less fonts.

Please rephrase your question!

[senthilkumar]

Hai kenny,

I got the code and it is working fine too. Actually I want to list out the fonts used in the document and also the fonts used in the document and not exists in the fontnames list. Here is the code.


------------------------------------------------------------------------------------------

Public Sub MissingandUsedFont()

Dim rngMissing As Range
Dim iCount As Integer
Dim sUsedFontList As String, sUnUsedFontList As String

On Error GoTo ERRORHANDLER
Selection.End = 0
Do While Selection.End < ActiveDocument.Range.End
Selection.SelectCurrentFont

If InStr(1, sUsedFontList, Selection.Font.Name & "|") = 0 And Selection.Font.Name <> "" Then
sUsedFontList = sUsedFontList & Selection.Font.Name & "|"
End If
If Selection.End = ActiveDocument.Range.End Then Exit Do
Selection.Start = Selection.End
Loop
sUnUsedFontList = sUsedFontList
For iCount = 1 To Application.FontNames.Count
If InStr(1, sUsedFontList, Application.FontNames.Item(iCount) & "|") > 0 Then
sUnUsedFontList = Replace(sUnUsedFontList, Application.FontNames.Item(iCount) & "|", "")
End If
Next iCount
If Right(sUsedFontList, 1) = "|" Then sUsedFontList = Mid(sUsedFontList, 1, Len(sUsedFontList) - 1)
If Right(sUnUsedFontList, 1) = "|" Then sUnUsedFontList = Mid(sUnUsedFontList, 1, Len(sUsedFontList) - 1)
' Adding the information in a seperate document
Documents.Add
ActiveDocument.Select
With Selection
.Delete
.Font.Bold = True
.TypeText "Fonts Used"
.Font.Bold = False
.TypeParagraph
.TypeText sUsedFontList
.TypeParagraph
.TypeParagraph
.Font.Bold = True
.TypeText "Missing Fonts"
.Font.Bold = False
.TypeParagraph
If sUnUsedFontList <> "" Then
.TypeText sUnUsedFontList
Else
.TypeText "There is no missing font in this document."
End If
Set rngMissing = ActiveDocument.Range
rngMissing.Find.ClearFormatting
rngMissing.Find.Execute findtext:="|", replacewith:="^p", Replace:=wdReplaceAll
End With
Exit Sub
ERRORHANDLER:
MsgBox "Some unknown error has occured. Please contact the administrator for further details." _
& vbCrLf & vbCrLf & Err.Description, vbCritical, "Missing Fonts"
End Sub

------------------------------------------------------------------------------------------

Thanks,
Senthil.

[fumei]

Please use the VBA code tags.

Sigh...and use Styles in your documents. It is how Word is designed to be used.

Also, could you explain: "also the fonts used in the document and not exists in the fontnames list. "

How is a font actually used in a document if it is not listed?