Word 2002/2003: Auflisten der Schriftarten
Ich würde in meinem Word (Office XP) gerne ein Dokument ausdrucken, das einen Beispielsatz in jeder hier installierten Schriftart zeigt. Früher habe ich dies von Hand gemacht, aber inzwischen sind so viele Fonts installiert, dass mir das zu mühsam wird. Gibts da eine schnellere Lösung?
Hierfür können Sie ein Makro verwenden. Gehen Sie zu Extras/Makro/Makros. Tippen Sie im Feld Makroname das Wort «Schriften» ein und klicken Sie auf Erstellen. Nun öffnet sich der Visual-Basic-Editor. Die erste Zeile «Sub Schriften()» und die letzte Zeile «End Sub» stehen schon da. Tippen (oder kopieren) Sie nun den Rest des Makrocodes zwischen diese Zeilen. Am Schluss beenden Sie den Editor via Datei/Schliessen und zurück zu Word. Öffnen Sie nun ein neues, leeres Dokument und darin nochmals das Menü Extras/Makro/Makros. Klicken Sie jetzt erst das neue Makro «Schriften» an und anschliessend die Schaltfläche Ausführen. Schon baut Word die gewünschte Schriftarten-Liste auf.
Kopieren Sie den Makro-Code, der zwischen den beiden gestrichelten Linien steht:
--------------------
Sub Schriften()
Selection.InsertAfter "Ausdruck der verfügbaren Schriftarten" + String$(2, 13)
Selection.Paragraphs.Alignment = wdAlignParagraphCenter
With Selection.Font
.Size = 18
.Bold = True
.Italic = True
End With
Selection.Collapse direction:=wdCollapseEnd
Set Tabelle = ActiveDocument.Tables.Add(Selection.Range, 1, 2)
Tabelle.Cell(1, 1).SetWidth ColumnWidth:=InchesToPoints(2), RulerStyle:=wdAdjustNone
Selection.InsertAfter "Schriftart"
Tabelle.Cell(1, 2).SetWidth ColumnWidth:=InchesToPoints(4), RulerStyle:=wdAdjustNone
Tabelle.Cell(1, 2).Range.InsertAfter "Beispiel in Schriftgröße 12"
Beispiel = "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz € ÄäÖöÜüß§0123456789" _
+ Chr$(34) + Chr$(132) + Chr$(147) + "@#$%&?!*"
Anzahl = FontNames.Count - 1
ReDim Schrift(Anzahl)
For z = 0 To Anzahl
Schrift(z) = FontNames(z + 1)
Next
For x = 0 To Anzahl
Selection.Tables(1).Rows.Add
Tabelle.Cell(x + 2, 1).Range.InsertAfter Schrift(x)
Tabelle.Cell(x + 2, 2).Range.InsertAfter Beispiel
With Tabelle.Cell(x + 2, 2).Range.Font
.Name = Schrift(x)
.Size = 12
End With
Next x
End Sub
--------------------
Laden Sie die PCtipp-App kostenlos auf Ihr Smartphone und bleiben Sie auf dem Laufenden.
![]()
Windows 7
Windows 2000
Windows XP
Windows Vista
Linux
Mac
Sicherheit
Internet
Office
Multimedia
Spiele
Hardware
Windows9x/NT
Mobile
Sonstiges
![]()
