MS Word - Find font in document

[S6PNJ]

I'm trying to hunt down where a certain font (or fonts) are used within an MS Word document. I've managed to find a macro which tells me what fonts are used in the doc, but I now need to know where they are within the document. I can't do a 'replace' and search for the font, as I don't have it installed and can't find the specific font for download.

To find the fonts used, I used option 2 in here: https://neuxpower.com/blog/list-fonts-used-in-word...
I then used this to try and find the font, but as I don't have it installed, it doesn't work (I can't select a font I don't have...)
https://answers.microsoft.com/en-us/msoffice/forum...

Any suggestions please?

[Mogul]

ChatGPT

[S6PNJ]

Thanks - I've never actually used Chat GPT so all I did was copy paste my question as above and yup, it gave me soem more VB code - which worked, though I still had to manually find the bit of text it promted to me - I was hoping it might highlight it as well.

Cheers!!

[Mogul]

ChatGPT is a total game changer for Excel and, as it would appear, Word formatting tips…


It would appear that there is a way to find fonts…


To replace a specific font in a Word document with an alternative font, follow these steps:

1. # Method 1: Using Word’s Replace Feature (Quick and Simple)

1. **Open the Word document.**
2. Press **Ctrl + H** (or **Cmd + H** on Mac) to open the **Find and Replace** dialog box.
3. Click on the **More >>** button if you don’t see extra options.
4. Click on **Format** > **Font** in the **Find what** section:

* Choose the **font you want to replace**.
* Click **OK**.
5. Click on **Format** > **Font** in the **Replace with** section:

* Choose the **new font** you want to use.
* Click **OK**.
6. Click **Replace All**.

This will change **only the font** while preserving the text and other formatting.

[S6PNJ]

Thanks, that wouldn't have worked for me as I didn't have the font installed so couldn't use the replacement function.

I'm guessing that ChatGPT works well in this instance as it's Visual Basic.

[S6PNJ]

I case anyone want the macros it generated, they are:

Option Explicit

Public Sub FindFontsUsed()

Dim sMsg As String

sMsg = GetFonts(ActiveDocument)
MsgBox "The fonts in this document are:" & vbNewLine & vbNewLine & sMsg

If Not CompareFonts(sMsg) = vbNullString Then

MsgBox "The following fonts are used in this document," & _
vbNewLine & "but are not installed on this PC:" & vbNewLine & CompareFonts(sMsg)
End If

End Sub

Private Function GetFonts(ByVal oDocument As Document) As String

Dim oParagraph As Paragraph
Dim i As Integer
Dim oWord As Words
Dim sFontType As String
Dim sMsg As String

For Each oParagraph In oDocument.Paragraphs
For i = 1 To oParagraph.Range.Characters.Count
sFontType = oParagraph.Range.Characters(i).Font.Name
If InStr(1, sMsg, sFontType) = 0 Then
sMsg = sMsg & sFontType & vbNewLine
End If
Next
Next

GetFonts = sMsg

End Function

Private Function CompareFonts(ByVal oFonts As String) As String

Dim vFont As Variant
Dim sMsg As String
Dim xFont As Variant
Dim i As Long
Dim allFonts As String

For Each vFont In FontNames
allFonts = allFonts & vbNewLine & vFont
Next vFont

xFont = Split(oFonts, vbNewLine)

For i = 0 To UBound(xFont)
If InStr(allFonts, xFont(i)) = 0 Then
sMsg = sMsg & vbNewLine & xFont(i)
End If
Next i

CompareFonts = sMsg

End Function

[S6PNJ]

and

Sub FindFontUsage()
    Dim para As Paragraph
    Dim run As Range
    Dim fontName As String
    Dim fontUsed As Boolean
    Dim result As String

    fontName = InputBox("Enter the font you want to search for:", "Font Search")
    If fontName = "" Then Exit Sub

    For Each para In ActiveDocument.Paragraphs
        For Each run In para.Range.Words
            fontUsed = False
            If run.Font.Name = fontName Then
                fontUsed = True
            End If
            If fontUsed Then
                result = result & "Font found in Paragraph " & para.Range.ListFormat.ListString & _
                        ": " & para.Range.Text & vbCrLf
            End If
        Next run
    Next para

    If result = "" Then
        MsgBox "Font not found in the document."
    Else
        MsgBox result
    End If
End Sub