' Dieses Makro ist in MS Word ausführbar.
' Das Makro schreibt die ASCII - Codes 65 bis 122 mit den entsprechenden
' Schriftzeichen in ein Worddokument.
' Die ASCII - Codes können erweitert werden zum Beispiel von 1 bis 300
' Achtung: Wenn viele Schriften installiert sind füllt das Makro viele Word Seiten.
' 15.08.2005 Sahib
' Sahib 15.08.05

' Programmbeginn:

Sub AltUndZahl()

' Schreibt alle Zeichen via Alt und Zahl in jeder Schrift die im Computer installiert ist

'Seiten Einrichten, d.h. die Ränder verkleinern

    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = CentimetersToPoints(2)
        .BottomMargin = CentimetersToPoints(2)
        .LeftMargin = CentimetersToPoints(1)
        .RightMargin = CentimetersToPoints(1)
        .Gutter = CentimetersToPoints(0)
        .HeaderDistance = CentimetersToPoints(1.25)
        .FooterDistance = CentimetersToPoints(1.25)
        .PageWidth = CentimetersToPoints(21)
        .PageHeight = CentimetersToPoints(29.7)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
    End With
'Sämliche Fontnamen (FontNames)aufzählen die im Computer installiert sind
For Each Listfont In FontNames
'In dieser Schrift wird der Fontname geschrieben
Selection.Font.Name = "Times New Roman"
 Selection.EndKey Unit:=wdLine, Extend:=wdExtend
 Selection.Font.Size = 12
 Selection.TypeText Text:=Listfont
Selection.TypeParagraph    'Neue Linie
    For i = 65 To 122
        Selection.Font.Name = "Times New Roman"
        Selection.Font.Size = 10
        Selection.TypeText Text:=i & " = "
'        Selection.TypeText Text:=i & vbTab
        Selection.Font.Name = Listfont
        Selection.TypeText Text:=Chr(i)
        Selection.Font.Name = "Times New Roman"
        Selection.TypeText Text:=", "
    Next i
Selection.TypeParagraph    'Neue Linie
Next Listfont
End Sub