Template_M12_Font

Excel VBA

Excel VBAで、実行ブックのフォントを取得し、文字サンプル、行高を表示します。
(Microsoft365 64bit環境推奨)

 G-Tool1-A01 からのつづき
 6.【Alt】+【F11】キーを押下し、VBE画面を出す。
 7.【挿入】タブから【標準モジュール】を選択し、標準モジュールを作成。
 8.下記ボックス内をコピーし、標準モジュールに貼り付ける。
 9.モジュール名を【M12_Font】に変更する。

 モジュール名:M12_Font
Option Explicit

'+++*****************************************************+++
'    フォントサンプル
'+++*****************************************************+++
Sub SampleFont()

   Call StopUpdating
    
'    With ActiveSheet
    With ThisWorkbook.Worksheets("Font")
         .Select
         'コマンドバー 名前
'        For i = 1 To Application.CommandBars.Count
'            .Cells(i, 1) = Application.CommandBars(i).Name
'        Next i
         'コマンド(フォーマッティング)のキャプション
'        For i = 1 To Application.CommandBars(14).Controls.Count
'            .Cells(i, 2) = Application.CommandBars(14).Controls(i).Caption
'        Next i
        .Range("A1").Value = "Font"
        .Range("B1").Value = "Sample1"
        .Range("C1").Value = "Sample2"
        .Range("D1").Value = "Height"
        ActiveWindow.FreezePanes = False
        Application.Goto reference:=Range("A1"), scroll:=True
        .Range("B2").Select
        ActiveWindow.FreezePanes = True
        'フォント一覧
        'エラーを無視
        On Error Resume Next
        For i = 1 To Application.CommandBars("Formatting").Controls(1).ListCount
            .Cells(i + 1, 1) = Application.CommandBars("Formatting").Controls(1).List(i)
            .Cells(i + 1, 2) = "あいうえお名前Hello1230"
            .Cells(i + 1, 3) = "アイウエオ1234567890abcdefgol"
            .Cells(i + 1, 4) = .Rows(i).Height
            .Range(.Cells(i + 1, 1), .Cells(i + 1, 4)).Font.Name = .Cells(i + 1, 1).Value
        Next i
        '.Columns("A:D").EntireColumn.AutoFit
        .Range("A1:D1").Interior.Color = 16249582      '薄いブルーグレー
        'エラー制御を戻す
        On Error GoTo 0
    End With
    Call Updating
End Sub

コメント

タイトルとURLをコピーしました