Detect if font installed- Hiding column

[kirkm]

Is it possible to detect programicably
if a certain font is installed ?

I did consider checking the Font folder
and if the font name exists, assume it is present
but there may be a better way.

If the font is missing I'd like to hide a
certain column in the spreadsheet.

Any help appreciated.

Thanks - Kirk

 

[Jim Cone]

Lyle Green posted the original code (December 2001) which listed all
fonts in a listbox on a userform. This is my adaptation.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


Sub ShowInstalledFonts()
' Jim Cone - San Francisco - September 2006
Dim FontCtrl As CommandBarControl
Dim i As Long
Dim strFont As String
Dim strArry() As String
Dim strName As String
Dim varResult As Variant

strFont = "DearTeacher-Normal"
Set FontCtrl = Application.CommandBars("Formatting").FindControl(ID:=1728)
ReDim strArry(1 To 1000)

'enters the available installed font names into the array.
'assumes there will not be > 2000 fonts.
For i = 1 To FontCtrl.ListCount
strName = FontCtrl.List(i)
strArry(i) = strName
If i > 999 Then ReDim Preserve strArry(1 To 2000)
Next ' i

varResult = Application.Match(strFont, strArry, 0)
If Not IsError(varResult) Then
MsgBox strArry(varResult) & " was found. "
Else
MsgBox strFont & " is not installed "
End If
Set FontCtrl = Nothing
End Sub


"kirkm" <[email protected]>
wrote in message

Is it possible to detect programicably
if a certain font is installed ?
I did consider checking the Font folder
and if the font name exists, assume it is present
but there may be a better way.
If the font is missing I'd like to hide a
certain column in the spreadsheet.
Any help appreciated.
Thanks - Kirk

 

[Jim Cone]

This revision eliminates the need for the ReDim Preserve.
--
Jim Cone
San Francisco, USA
http://www.officeletter.com/blink/specialsort.html

Sub ShowInstalledFonts_R1()
' Jim Cone - San Francisco - September 2006
Dim FontCtrl As CommandBarControl
Dim i As Long
Dim lngCount As Long
Dim strFont As String
Dim strArry() As String
Dim strName As String
Dim varResult As Variant

strFont = "Comic Sans MS"
Set FontCtrl = Application.CommandBars("Formatting").FindControl(ID:=1728)
lngCount = FontCtrl.ListCount
ReDim strArry(1 To lngCount)

'enters the available installed font names into the array.
For i = 1 To lngCount
strName = FontCtrl.List(i)
strArry(i) = strName
Next ' i

varResult = Application.Match(strFont, strArry, 0)
If Not IsError(varResult) Then
MsgBox strArry(varResult) & " was found. "
Else
MsgBox strFont & " is not installed "
End If
Set FontCtrl = Nothing
End Sub

 

[kirkm]

Thank you very much, Jim.

Cheers - Kirk