List all Font Names in a Range ...

[Guest]

Hi,

I would like to list all available Fonts, but not the file name ("abac.ttf") but the Font name ("Abadi MT Condensed").
In fact it's for applying the font to the next column.

Range("A1").Font.Name = "abac.ttf" ==> runs but it doesn't work like :
Range("A1").Font.Name = "Abadi MT Condensed"

Thanks,
Alx.

 

[Ivan F Moala]

To get the fonts names try this<pre/>
Sub GetFonts()
Dim Fonts
Dim x As Integer

Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Select '.ClearFormats
x = 1
Set Fonts = Application.CommandBars.FindControl(ID:=1728)

On Error Resume Next
Do Until Err<> 0
Cells(x + 1, 1) = Fonts.List(x)
x = x + 1
Loop

Range("A1").FormulaR1C1 = "=""Font List = "" & COUNTA(R[1]C:R[500]C)"

With Range("A1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Name = "Arial"
.Font.FontStyle = "Bold"
.Font.Size = 10
.Font.Strikethrough = False
.Font.Superscript = False
.Font.ColorIndex = 5
.Font.Interior.ColorIndex = 15
End With
Columns("A:A").EntireColumn.AutoFit

Set Fonts = Nothing

End Sub</pre>


Ivan
This message was edited by Ivan F Moala on 2002-07-21 23:22

 

[excelyoozer]

Excellent Ivan!

I did a search and found this to be exactly what I was looking for.
I appreciate it!

Tom

 

[gnaga]

Set Fonts = Application.CommandBars.FindControl(ID:=1728)

Ivan where from we get all the commandbar ID number? ID 1728 belongs to font name dropdown box control in the format command bar am I right?

 

[Ivan F Moala]

Yes, thats correct....

try something like this to get them...

 

[Maurizio]

To get the fonts names try this<pre/>
Sub GetFonts()
Dim Fonts
Dim x As Integer

Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Select '.ClearFormats
x = 1
Set Fonts = Application.CommandBars.FindControl(ID:=1728)

On Error Resume Next
Do Until Err<> 0
Cells(x + 1, 1) = Fonts.List(x)
x = x + 1
Loop

Range("A1").FormulaR1C1 = "=""Font List = "" & COUNTA(R[1]C:R[500]C)"

With Range("A1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Name = "Arial"
.Font.FontStyle = "Bold"
.Font.Size = 10
.Font.Strikethrough = False
.Font.Superscript = False
.Font.ColorIndex = 5
.Font.Interior.ColorIndex = 15
End With
Columns("A:A").EntireColumn.AutoFit

Set Fonts = Nothing

End Sub</pre>


Ivan
This message was edited by Ivan F Moala on 2002-07-21 23:22

Hi Ivan,
but how can I get a sample for each font too?

Tia.

 

[Juan Pablo González]

Loop through each cell and do something like

For Each Cll In Range("A2", Range("A65536").End(xlUp))
    Cll.Font.Name = Cll.Value
Next Cll

 

[Ivan F Moala]

Thanks Juan....I went away looking for the File

 

[Maurizio]

Thanks Juan to me, also.

 

[Maurizio]

Hi Juan Pablo,
using:

For Each Cll In Range("A2", Range("A65536").End(xlUp))
Cll.Font.Name = Cll.Value
Next Cll

with excel 97 after 150 fonts I get "Insufficient memory" and then error 404, not with excel XP.
Any solution for old excel 97?

Tia.