Schriftarten-Übersichtsliste drucken

Ich möchte einen Beispieltext aus Excel in alle verfügbaren Schriftarten drucken, ohne jede Schriftart einzeln auswählen zu müssen.
Ich habe nur ein vbs_script gefunden, welches das Euro-Zeichen darstellt ! Kann man hier dieses Zeichen vielleicht auf den Beispieltext abändern ?

Danke für jede Hilfe !

 

Besten Dank, funktioniert bestens !

 

Nachfolgend ein Makro, das für alle installierten Schriftarten den Namen der Schrift und eine Testzeile (ABC....) ausdruckt. Allerdings habe ich es für Word geschrieben, es sollte aber (modifiziert) auch unter Excel funktionieren.
mfg Fritz Weinel

Sub Schriftarten()
\'
Dim Fontcnt As Integer
Dim i As Integer

Documents.Add
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape
.TopMargin = CentimetersToPoints(2.5)
.BottomMargin = CentimetersToPoints(1)
.LeftMargin = CentimetersToPoints(1)
.RightMargin = CentimetersToPoints(1)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.25)
.FooterDistance = CentimetersToPoints(1.25)
.PageWidth = CentimetersToPoints(29.7)
.PageHeight = CentimetersToPoints(21)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
End With
Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(6), _
Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
Selection.Font.Size = 10

Fontcnt = FontNames.Count

For i = 1 To Fontcnt
Selection.Font.Name = "Arial"
Selection.TypeText Text:=FontNames(i) & vbTab
Selection.Font.Name = FontNames(i)
Selection.TypeText Text:="€ ABCDEFGHIJKLMNOPQRSTUVWXYZ 01234567890"
Selection.TypeParagraph
Next
Selection.WholeStory
Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=2, _
NumRows:=Fontcnt, Format:=wdTableFormatNone, ApplyBorders:=True,
ApplyShading _
:=True, ApplyFont:=True, ApplyColor:=True, ApplyHeadingRows:=True, _
ApplyLastRow:=False, ApplyFirstColumn:=True, ApplyLastColumn:=False, _
AutoFit:=False
Selection.Sort ExcludeHeader:=False, FieldNumber:="Spalte1", SortFieldType _
:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, FieldNumber2 _
:="", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _
wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _
wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending, Separator:= _
wdSortSeparateByTabs, SortColumn:=False, CaseSensitive:=False, LanguageID _
:=wdLanguageNone
Selection.Rows.ConvertToText Separator:=wdSeparateByTabs
Selection.HomeKey Unit:=wdStory
End Sub