フォントリストの印刷（Microsoft Word）

Sub ListFontNames()

Dim J As Integer     Dim NewDoc As Document

' Create a new document     Set NewDoc = Documents.Add

' Add font names to document     For J = 1 To FontNames.Count         Selection.TypeText (FontNames(J))

Selection.TypeParagraph     Next J End Sub

Sub FontExamples()

Dim J As Integer     Dim F As Integer     Dim sTemp As String     Dim sTest As String     Dim Continue As Integer     Dim rng As Range     Dim FontTable As Table     Dim NewDoc As Document

' Specify the sample text for second column     sTest = "ABCDEFG abcdefg 1234567890"



' Check to see if the user wants to proceed     F = FontNames.Count     sTemp = "There are " & F & " fonts on this system."

sTemp = sTemp & "Building the document may take quite a while."

sTemp = sTemp & "Do you want to continue?"

Continue = MsgBox(sTemp, vbYesNo, "Build Font List")



If Continue = vbYes Then         ' Put together a string that contains the table contents         sTemp = "Font Name" & vbTab & "Font Example"

For J = 1 To F             sTemp = sTemp & vbCr & FontNames(J) & vbTab & sTest         Next J

' Create a new document         Set NewDoc = Documents.Add

' Add string contents and convert to table         Set rng = Selection.Range         rng.Text = sTemp         Set FontTable = rng.ConvertToTable(Separator:=vbTab, _           AutoFitBehavior:=wdAutoFitFixed)



' Set general table properties         With FontTable             .Borders.Enable = False             .Range.Font.Name = "Arial"

.Range.Font.Size = 10             .Rows(1).Range.Font.Bold = True             .Rows(1).Range.Font.Size = 12         End With

' Go through the sample cells and format them         For J = 1 To F             FontTable.Cell(J + 1, 2).Range.Font.Name = FontNames(J)

Next J

' Sort the table         FontTable.Sort SortOrder:=wdSortOrderAscending     End If End Sub