I need to make an array of font objects, I don't even seem to be able to
make even one. Why doesn't this code work:

Public Sub x()
Dim f as Font
Set f = New Font
f.Name = "Arial"
End Sub

I'm getting an error on the 2nd line, "Invalid use of New keyword". Any
thoughts?

- Rm

Hi Robert,

Try the following code which endeavours to adapt some code by John
Walkenbach to meet your needs:

'=================
Public Sub Tester()
Dim FontList As CommandBarComboBox
Dim i As Long
Dim tempbar As CommandBar
Dim arr As Variant

On Error Resume Next
Set FontList = Application.CommandBars("Formatting"). _
FindControl(ID:=1728)

If FontList Is Nothing Then
Set tempbar = Application.CommandBars.Add
Set FontList = tempbar.Controls.Add(ID:=1728)
End If

ReDim arr(1 To FontList.ListCount)
On Error GoTo 0
For i = 1 To FontList.ListCount - 1
arr(i) = FontList.List(i)
Next i

' Delete temp CommandBar if it exists
On Error Resume Next
tempbar.Delete
End Sub
'<<=================


---
Regards,
Norman



"Robert Mulroney" '''' wrote in message
...

I need to make an array of font objects, I don't even seem to be able to
make even one. Why doesn't this code work:

Public Sub x()
Dim f as Font
Set f = New Font
f.Name = "Arial"
End Sub

I'm getting an error on the 2nd line, "Invalid use of New keyword". Any
thoughts?

- Rm

Hi Robert,

ReDim arr(1 To FontList.ListCount)

was intended as:

ReDim arr(1 To FontList.ListCount - 1)


---
Regards,
Norman


"Norman Jones" wrote in message
...
Hi Robert,

Try the following code which endeavours to adapt some code by John
Walkenbach to meet your needs:

'=================
Public Sub Tester()
Dim FontList As CommandBarComboBox
Dim i As Long
Dim tempbar As CommandBar
Dim arr As Variant

On Error Resume Next
Set FontList = Application.CommandBars("Formatting"). _
FindControl(ID:=1728)

If FontList Is Nothing Then
Set tempbar = Application.CommandBars.Add
Set FontList = tempbar.Controls.Add(ID:=1728)
End If

ReDim arr(1 To FontList.ListCount)
On Error GoTo 0
For i = 1 To FontList.ListCount - 1
arr(i) = FontList.List(i)
Next i

' Delete temp CommandBar if it exists
On Error Resume Next
tempbar.Delete
End Sub
'<<=================


---
Regards,
Norman

That's really very tricky, I'm quite impressed.

What I'm working on is a Rich text parser for Excel. In the rich text syntax
all the font's are defiend in the header of the file. I want to make and
array of the "type" Font that represents all the fonts in the rtf header.

something along the lines of :


Private fonts() As Font


sub fontTable()

dim workingFont as integer
workingFont = 0.
..
..
..

'add a new font
ReDim Preserve fonts(0 To workingFont)
fonts(workingFont) = new Font
'but I get an error here.^



Thanks for your help

- Rm







"Norman Jones" wrote:

Hi Robert,

ReDim arr(1 To FontList.ListCount)

was intended as:

ReDim arr(1 To FontList.ListCount - 1)


---
Regards,
Norman


"Norman Jones" wrote in message
...
Hi Robert,

Try the following code which endeavours to adapt some code by John
Walkenbach to meet your needs:

'=================
Public Sub Tester()
Dim FontList As CommandBarComboBox
Dim i As Long
Dim tempbar As CommandBar
Dim arr As Variant

On Error Resume Next
Set FontList = Application.CommandBars("Formatting"). _
FindControl(ID:=1728)

If FontList Is Nothing Then
Set tempbar = Application.CommandBars.Add
Set FontList = tempbar.Controls.Add(ID:=1728)
End If

ReDim arr(1 To FontList.ListCount)
On Error GoTo 0
For i = 1 To FontList.ListCount - 1
arr(i) = FontList.List(i)
Next i

' Delete temp CommandBar if it exists
On Error Resume Next
tempbar.Delete
End Sub
'<<=================


---
Regards,
Norman

Hi Robert,

The Font object is accessed by using the Font property

The following sub demonstrates loading a module level array (arr) with the
available font names:

'=================
Option Explicit
Public arr As Variant

'=================
Public Sub Tester2()
Dim FontList As CommandBarComboBox
Dim i As Long
Dim tempbar As CommandBar

On Error Resume Next
Set FontList = Application.CommandBars("Formatting"). _
FindControl(ID:=1728)

If FontList Is Nothing Then
Set tempbar = Application.CommandBars.Add
Set FontList = tempbar.Controls.Add(ID:=1728)
End If

ReDim arr(1 To FontList.ListCount - 1)
On Error GoTo 0
For i = 1 To FontList.ListCount - 1
arr(i) = FontList.List(i)
Next i

' Delete temp CommandBar if it exists
On Error Resume Next
tempbar.Delete


End Sub
'<<=================

The following demonstrates reading the available font names which are held
in the module level arr.

Note that no error checking is included and if arr should not be loaded, the
sub will error.

'=================
Sub ReadFontList()
Dim i As Long
For i = 1 To UBound(arr)
Debug.Print arr(i)
Next i
End Sub
'<<=================

Since you can read off the font names you can do as you wish with the
resultantly accessible fonts.

If you wish to produce an array holding a selected subset of available
fonts, of course you can do that. In this case, you would use the new array
it in much the same way as would be the case were you to use the present
array.


Regards,
Norman



"Robert Mulroney" '''' wrote in message
...
That's really very tricky, I'm quite impressed.

What I'm working on is a Rich text parser for Excel. In the rich text
syntax
all the font's are defiend in the header of the file. I want to make and
array of the "type" Font that represents all the fonts in the rtf header.

something along the lines of :


Private fonts() As Font


sub fontTable()

dim workingFont as integer
workingFont = 0.
.
.
.

'add a new font
ReDim Preserve fonts(0 To workingFont)
fonts(workingFont) = new Font
'but I get an error here.^



Thanks for your help

- Rm







"Norman Jones" wrote:

Hi Robert,

ReDim arr(1 To FontList.ListCount)

was intended as:

ReDim arr(1 To FontList.ListCount - 1)


---
Regards,
Norman


"Norman Jones" wrote in message
...
Hi Robert,

Try the following code which endeavours to adapt some code by John
Walkenbach to meet your needs:

'=================
Public Sub Tester()
Dim FontList As CommandBarComboBox
Dim i As Long
Dim tempbar As CommandBar
Dim arr As Variant

On Error Resume Next
Set FontList = Application.CommandBars("Formatting"). _
FindControl(ID:=1728)

If FontList Is Nothing Then
Set tempbar = Application.CommandBars.Add
Set FontList = tempbar.Controls.Add(ID:=1728)
End If

ReDim arr(1 To FontList.ListCount)
On Error GoTo 0
For i = 1 To FontList.ListCount - 1
arr(i) = FontList.List(i)
Next i

' Delete temp CommandBar if it exists
On Error Resume Next
tempbar.Delete
End Sub
'<<=================


---
Regards,
Norman