Hi Peter

Check my last reply to Gary's Student. I've come across some very
interesting fonts, of which I'm using Monaco (gotta love those parentheses).
Regards Brett.

"Peter T" wrote:

This should show you most of your fixed width fonts (not necessarily all and
not sure why not)

In a normal module and run GetFixedFonts on a new sheet

Option Explicit

'Private Const LF_FULLFACESIZE As Long = 64
'Private Const FF_ROMAN As Long = 16
'Private Const FF_SWISS As Long = 32
'Private Const FF_MODERN As Long = 48
'Private Const FF_SCRIPT As Long = 64

Private Const ANSI_CHARSET = 0
'private Const DEFAULT_CHARSET = 1

Private Const LF_FACESIZE = 32
Private Const TMPF_FIXED_PITCH As Long = &H1

Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(1 To LF_FACESIZE) As Byte
End Type

Private Type FONTSIGNATURE
fsUsb(4) As Long
fsCsb(2) As Long
End Type

Private Type NEWTEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
ntmFlags As Long
ntmSizeEM As Long
ntmCellHeight As Long
ntmAveWidth As Long
End Type

Private Type NEWTEXTMETRICEX
ntmTm As NEWTEXTMETRIC
ntmFontSig As FONTSIGNATURE
End Type

Private Declare Function EnumFontFamiliesEx Lib "gdi32" _
Alias "EnumFontFamiliesExA" ( _
ByVal hDC As Long, ByRef lpLogFont As LOGFONT, _
ByVal lpEnumFontProc As Long, _
ByVal LParam As Long, ByVal dw As Long) As Long

Private Declare Function DeleteDC Lib "gdi32.dll" ( _
ByVal hDC As Long) As Long
Private Declare Function GetDC Lib "user32.dll" ( _
ByVal hWnd As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32.dll" _
Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

Private mcFixed As Collection ', mcVar As Collection

Private Function EnumFontFamExProc(ByRef tLF As LOGFONT, _
ByRef tNTM As NEWTEXTMETRICEX, _
ByVal FontType As Long, ByRef LParam As Long) As Long
Dim sFontName As String

sFontName = StrConv(tLF.lfFaceName, vbUnicode)
sFontName = Left$(sFontName, InStr(sFontName & Chr$(0), Chr$(0)) - 1)

If (tLF.lfPitchAndFamily And TMPF_FIXED_PITCH) = TMPF_FIXED_PITCH Then
mcFixed.Add sFontName
'Elseif etc others

End If

EnumFontFamExProc = 1
End Function

Sub GetFixedFonts()
Dim hWndApp As Long, hWndXL7 As Long, hDC As Long
Dim i As Long
Dim sample As String
Dim tLgFnt As LOGFONT

Set mcFixed = New Collection

If Val(Application.Version) 9 Then
hWndApp = Application.hWnd
Else
hWndApp = FindWindow("XLMAIN", Application.Caption)
End If

hWndXL7 = FindWindowEx( _
FindWindowEx(hWndApp, 0, "XLDESK", vbNullString), _
0&, "EXCEL7", vbNullString)

hDC = GetDC(hWndXL7)

EnumFontFamiliesEx hDC, tLgFnt, AddressOf EnumFontFamExProc, ByVal 0&, 0

DeleteDC hDC

sample = "My Sample Text"
' or
sample = alphabet

For i = 1 To mcFixed.Count
Cells(i, 1) = mcFixed.Item(i)
With Cells(i, 2)
.Font.Name = mcFixed.Item(i)
.Value = sample
End With
Next

Range("A:B").EntireColumn.AutoFit
Set mcFixed = Nothing

End Sub

Function alphabet() As String
Dim i As Long
Dim s As String
For i = 65 To 65 + 25
s = s & Chr(i)
Next
alphabet = LCase(s) & s
End Function


Regards,
Peter T

"Brettjg" wrote in message
...
Hello again

I have been using the very pleasant Tahoma font for my VBE but I probably
need to switch to a monowidth font for alignment reasons. As an ex visual
arts type I can't bleeding well stand the sight of Courier so I searched
Google with not a lot of luck.

So, can anyone tell me what other reasonably handsome monowidth fonts are
available? Regards, Brett