【Word VBA】フォント一覧表作成マクロ▽ソースコード

Option Explicit

Option Base 0

Public Sub フォント一覧表作成マクロ()

    Const FONTDFNAM = "ＭＳ 明朝"　　　　 'フォント名フォント

    Const FONTDSIZE = 14 　　　　　　　　  'フォントサイズ

    Const FONTSMCHR = "ABC123ゆういち"   'サンプル文字

    '---------------------------------------------------------------------------

    Dim Ip As Integer

    Dim tblFnt As Table, rowFnt As row

    '*既存の表を削除

    For Ip = ActiveDocument.Tables.Count To 1 Step -1

        ActiveDocument.Tables.Item(Ip).Delete

    Next Ip

    '*表作成

    Set tblFnt = ActiveDocument.Tables.Add( _

                 Range:=ActiveDocument.Range(Start:=0, End:=0), _

                 NumRows:=1, NumColumns:=2)

    tblFnt.Style = "表 (格子)"

    '*見出し

    tblFnt.Cell(1, 1).Range.Text = "フォント名"

    tblFnt.Cell(1, 2).Range.Text = "サ ン プ ル"

    '*フォント一覧作成

    With Application.CommandBars.Add

         With .Controls.Add(ID:=1728)

               For Ip = 1 To .ListCount - 1

                   Set rowFnt = tblFnt.Rows.Add

                   rowFnt.Cells(1).Range.Text = .List(Ip)

                   rowFnt.Cells(1).Range.Font.Name = FONTDFNAM

                   rowFnt.Cells(1).Range.Font.Size = FONTDSIZE

                   rowFnt.Cells(2).Range.Text = FONTSMCHR

                   rowFnt.Cells(2).Range.Font.Name = .List(Ip)

                   rowFnt.Cells(2).Range.Font.Size = FONTDSIZE

               Next Ip

         End With

    End With

End Sub