Generare la lista dei font disponibili su Microsoft Word

Oggi solita richiesta 'inusuale':

Cliente: Ho bisogno di creare la lista dei font disponibili sul mio PC, per poi stamparli e avere un prontuario rapido, invece che andare a scorrere la tendina della scelta font.

Io: (Gh!) ok, vedo che posso fare....

Come al solito, google trova quasi immediatamente la soluzione: una semplice macro per Ms Word, direttamente dal sito di supporto della Microsoft.

La seguente macro di esempio di Visual Basic Applications Edition crea un nuovo documento vuoto e inserisce un esempio di ogni carattere disponibile:

[sourcecode language="vb"]
Sub ListFonts()
Dim varFont As Variant
' Speeds macro processing and suppresses display.
Application.ScreenUpdating = False
' Create new document.
Documents.Add Template:="normal"

' Loop through each available font.
For Each varFont In FontNames
With Selection
' Format for name of font.
.Font.Name = "times new roman"
.Font.Bold = True
.Font.Underline = True
' Insert Font name.
.TypeText varFont
' Insert a new paragraph after the Font Name.
.InsertParagraphAfter
' Move to the new paragraph.
.MoveDown unit:=wdParagraph, Count:=1, Extend:=wdMove
' Format for the font example.
.Font.Bold = False
.Font.Underline = False
.Font.Name = varFont
' Enter example text(Alphabetic characters.)
.TypeText "abcdefghijklmnopqrstuvwxyz"
' Insert a new paragraph.
.InsertParagraphAfter
' Move to the new paragraph.
.MoveDown unit:=wdParagraph, Count:=1, Extend:=wdMove
' Insert example text(Numeric characters.)
.TypeText "0123456789?$%&()[]*_-=+/<>"
' Insert two new paragraphs and move down.
.InsertParagraphAfter
.InsertParagraphAfter
.MoveDown unit:=wdParagraph, Count:=1, Extend:=wdMove
End With

Next varFont
Application.ScreenUpdating = True

End Sub
[/sourcecode]