Sub Font()
‘書体見本帳作成
Sheets.Add.Name = “Font見本”
Cells(1, 1) = “No” ‘1列目の見出し名[ No ] 番号
Cells(1, 2) = “Font Name” ‘1列目の見出し名[ Font Name ] フォント名
Cells(1, 3) = “uppercase” ‘1列目の見出し名[ uppercase ] 英語大文字
Cells(1, 4) = “lower case” ‘1列目の見出し名[ lower case ]英語小文字
Cells(1, 5) = “numeral” ‘1列目の見出し名[ numeral ] 数字表記
Cells(1, 6) = “Japanese” ‘1列目の見出し名[ Japanese ] 日本語表記
Dim i As Integer
Dim str As String
Dim obj As Object
str1 = “ABCFGJIQMWZL” ‘アルファベット表記文字
str2 = “愛の美しいようす” ‘日本簿表記文字
num = “1234567890” ‘数字表記文字
‘フォント名やフォントの数量を取得するための「式」
Set obj = Application.CommandBars(“Formatting”). _
Controls.Item(1)
‘フォントの数量を終点として、フォント名を表示していく
For i = 1 To obj.ListCount
Cells(i + 1, 1) = i
Cells(i + 1, 2) = obj.List(i)
Cells(i + 1, 3) = str1
Cells(i + 1, 4).FormulaR1C1 = “=LOWER(RC[-1])”
Cells(i + 1, 5) = num
Cells(i + 1, 6) = str2
Cells(i + 1, 6).Font.Name = obj.List(i)
Cells(i + 1, 5).Font.Name = obj.List(i)
Cells(i + 1, 3).Font.Name = obj.List(i)
Cells(i + 1, 4).Font.Name = obj.List(i)
Next i
‘セルの幅を調整
Cells.Select
Cells.EntireColumn.AutoFit
End Sub