Word・PowerPointでは、「Ctrl + Shift + .」でフォントサイズを大きく、「Ctrl + Shift + ,」でフォントサイズを小さくすることができます。
ですが、Excelにはその機能がありません。
最近個人用マクロブックというものを知ったので、
これを用いてExcelで実装してみました。
マクロ
Qiitaのフォントの関係でコメントにずれが生じていますが、VBEに貼り付けるとずれなく表示されます。
※VBEに設定されているフォント次第ではずれる可能性があります。
' *************************** フォントサイズ拡大マクロ *******************************
' * *
' * 選択されたセルのフォントサイズを1つ大きくする。 *
' * フォントサイズについてはホームタブのフォントから選択できるフォントサイズに準拠。 *
' * 複数セルが選択された場合はセル毎に拡大を行う。 *
' * 空白セルは無視。 *
' * *
' ************************************************************************************
Sub ResizeLargeText()
Application.ScreenUpdating = False
'フォントサイズ定義
Dim fosize() As Variant
fosize = Array(6, 8, 9, 10, 11, 12, 14, 16, 18, 20, 22, 24, 26, 28, 36, 48, 72)
Dim selcell As Range
For Each selcell In Selection
If selcell.Font.Size < 72 And selcell.Value <> vbNullString Then
Dim fsize As Variant
For Each fsize In fosize()
If selcell.Font.Size < fsize Then
selcell.Font.Size = fsize
Exit For
End If
Next
End If
Next
Application.ScreenUpdating = True
End Sub
' *************************** フォントサイズ縮小マクロ *******************************
' * *
' * 選択されたセルのフォントサイズを1つ小さくする。 *
' * フォントサイズについてはホームタブのフォントから選択できるフォントサイズに準拠。 *
' * 複数セルが選択された場合はセル毎に縮小を行う。 *
' * 空白セルは無視。 *
' * *
' ************************************************************************************
Sub ResizeLittleText()
Application.ScreenUpdating = False
'フォントサイズ定義
Dim fosize() As Variant
fosize = Array(6, 8, 9, 10, 11, 12, 14, 16, 18, 20, 22, 24, 26, 28, 36, 48, 72)
Dim selcell As Range
For Each selcell In Selection
If selcell.Font.Size < 72 And selcell.Value <> vbNullString Then
Dim i As Integer
For i = UBound(fosize) - 1 To 0 Step -1
If selcell.Font.Size > fosize(i) Then
selcell.Font.Size = fosize(i)
Exit For
End If
Next
End If
Next
Application.ScreenUpdating = True
End Sub
現在選択されているセルに対し、各セルの現在のフォントサイズを取得して、
ホームタブのフォントにあるフォントサイズに記載のフォントに一番近いフォントサイズへ変更します。
各セル毎の設定となるため、対象セル数が多い場合は少し時間がかかります。
100程度では問題ないですが、1000とかになってくると1秒程度かかります。
ショートカットキー設定
ショートカットキーを割り当てます。
Sub ShortcutKey()
'「Crtl + Shift + .」を「ResizeLargeText」に割り当てる
Application.OnKey "^+.", "ResizeLargeText"
'「Crtl + Shift + ,」を「ResizeLittleText」に割り当てる
Application.OnKey "^+,", "ResizeLittleText"
End Sub
Excel起動時にショートカットキーが割り当たるようにします。
Private Sub Workbook_Open()
ShortcutKey
End Sub
追記
コメントにてボタンを押したときの方のマクロを紹介いただきましたので、
記載いたします。
この場合は各セルごとではなく、全てのセルまとめての拡大・縮小になるため、
一番大きい・小さいサイズのセルに合わせて残りのセルが拡大・縮小していき、
すべてのセルが同じサイズになったらまとめて拡大・縮小となります。
'フォントの拡大
CommandBars.ExecuteMso ("FontSizeIncrease")
'フォントの縮小
CommandBars.ExecuteMso ("FontSizeDecrease")