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
コメント