Excelにフォントサイズ変更のショートカットキーをWordと同じ挙動になるよう割り当ててみた

Word・PowerPointでは、「Ctrl + Shift + .」でフォントサイズを大きく、「Ctrl + Shift + ,」でフォントサイズを小さくすることができます。
ですが、Excelにはその機能がありません。

最近[個人用マクロブック](https://qiita.com/iguru/items/a27be8ffb8ae55cf7785)というものを知ったので、
これを用いてExcelで実装してみました。

# マクロ

:::note info
Qiitaのフォントの関係でコメントにずれが生じていますが、VBEに貼り付けるとずれなく表示されます。
※VBEに設定されているフォント次第ではずれる可能性があります。
:::

```vb:フォントサイズ変更
' *************************** フォントサイズ拡大マクロ *******************************
' *                                                                                  *
' * 選択されたセルのフォントサイズを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
```

現在選択されているセルに対し、各セルの現在のフォントサイズを取得して、
ホームタブのフォントにあるフォントサイズに記載のフォントに一番近いフォントサイズへ変更します。
各セル毎の設定となるため、対象セル数が多い場合は少し時間がかかります。

:::note info
100程度では問題ないですが、1000とかになってくると1秒程度かかります。
:::

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/855481/c30ffcaf-6524-4438-9997-b8d6db3146e0.png)


#### ショートカットキー設定

ショートカットキーを割り当てます。

```vb:ショートカットキー設定
Sub ShortcutKey()    
    '「Crtl + Shift + .」を「ResizeLargeText」に割り当てる
    Application.OnKey "^+.", "ResizeLargeText"
    
    '「Crtl + Shift + ,」を「ResizeLittleText」に割り当てる
    Application.OnKey "^+,", "ResizeLittleText"
End Sub
```

Excel起動時にショートカットキーが割り当たるようにします。

```vb:ThisWorkbook
Private Sub Workbook_Open()
    
    ShortcutKey
    
End Sub
```

# 追記

コメントにてボタンを押したときの方のマクロを紹介いただきましたので、
記載いたします。
この場合は各セルごとではなく、全てのセルまとめての拡大・縮小になるため、
一番大きい・小さいサイズのセルに合わせて残りのセルが拡大・縮小していき、
すべてのセルが同じサイズになったらまとめて拡大・縮小となります。

```vb
'フォントの拡大
CommandBars.ExecuteMso ("FontSizeIncrease")

'フォントの縮小
CommandBars.ExecuteMso ("FontSizeDecrease")

```