List all Font Names in a Range ...

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

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

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]

Originally Posted by Ivan F Moala

To get the fonts names try this

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

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.