Find out if the user has a specific font installed?

[Cindy Ellis]

Hi all,
I've used this macro from guyborchers http://www.mrexcel.com/board2/viewtopic.php?t=259599 along with a bit of other coding of my own creation to develop an application that will display some product data as barcodes. If a user opens this workbook, but doesn't have the correct barcode font, I would like to take some specific actions (no problem coding those) ... I just can't figure out how to access the list of installed fonts to find out if they have the right one installed. I assume(d) that the fonts were a collection, but it doesn't appear to be at the (Excel) application level.
Any help would be appreciated.

 

[Tom Urtis]

In a new fresh standard module...note, be sure to paste ALL the code, especially the Option Compare Text statement that shall be placed at the top of the module, just as I depict it here:

Option Compare Text


Sub Test1()
Dim myFont$
myFont = InputBox("Enter font name:", "Font type installed?")
If myFont = "" Then Exit Sub
Dim cnt As CommandBarControl, i%
Set cnt = Application.CommandBars.FindControl(ID:=1728)
For i = 1 To cnt.ListCount
If myFont = cnt.List(i) Then
MsgBox "Yes, the font ''" & myFont & "'' is installed.", , "Verified"
Exit Sub
Exit For
End If
Next i
MsgBox "No, the font ''" & myFont & "'' is NOT installed.", , "Missing"
End Sub

By the way, I know you did not ask for this, but here is a fun macro that will list all the fonts in column A of the active sheet, and also show those font names in their respective font type. Thanks Hans Herber.

Sub ListFonts()
Dim cnt As CommandBarControl, i%
Application.ScreenUpdating = False
Set cnt = Application.CommandBars.FindControl(ID:=1728)
For i = 1 To cnt.ListCount
With Cells(i, 1)
.Value = cnt.List(i)
.Font.Name = cnt.List(i)
End With
Next i
Columns(1).AutoFit
Application.ScreenUpdating = True
End Sub

 

[Cindy Ellis]

Thanks Tom! It works great. I modified it a bit, and call it from code associated with ThisWorkbook so that it executes automatically whenever the workbook opens.
Here's my final code:

Option Compare Text


Sub CheckFont()
Dim myFont$
myFont = "Code128bWinLarge"
Dim cnt As CommandBarControl, i%
Set cnt = Application.CommandBars.FindControl(ID:=1728)
For i = 1 To cnt.ListCount
If myFont = cnt.List(i) Then
    For Each Sh In Sheets
        If Sh.Name = ("Barcodes") Then Sh.Visible = True
    Next Sh
Exit Sub
Exit For
End If
Next i
MsgBox "To access barcodes, contact IT to have the font''" & myFont & "'' installed.", , "Missing"
    For Each Sh In Sheets
        If Sh.Name = ("Barcodes") Then Sh.Visible = False
    Next Sh
End Sub

Regarding the "fun" macro...I had something like that in Excel 4.0(?), before VBA was Excel's macro language, so I knew it should be possible, but I couldn't figure it out in VBA on my own. Mr. Excel to the rescue! Thanks again,
Cindy