Sub ◆selection_行の高さを自動調節_改()
    'InputBox で 自動調整時に何pt大きくするか指定
    Dim inputMsg As String: inputMsg = "選択行の高さを自動調整します。サイズのバッファを入力してください。"
    Dim sizeBuf:    sizeBuf = InputBox(inputMsg, "sizeBufを入力", 1)
     
    If IsNumeric(sizeBuf) = False Or sizeBuf < 0 Then _
        Call errorEnd("サイズバッファは、0以上の整数で指定してください。")
         
    Dim strRows As String
    strRows = Selection(1).Row & ":" & Selection(Selection.Count).Row
    
    Application.ScreenUpdating = False
    
    If sizeBuf <> 0 Then Call selection_makeFontBigger(sizeBuf)  'n pt大きく
    Rows(strRows).AutoFit '行の高さを自動調節
    If sizeBuf <> 0 Then Call selection_makeFontBigger(-sizeBuf) 'n pt小さく
    
    Application.ScreenUpdating = True
End Sub
Private Sub selection_makeFontBigger(pt)
    Dim r As range
    For Each r In Selection
        r.Font.Size = r.Font.Size + pt
    Next r
End Sub

'エラー発生時にメッセージを出力して終了させる
Private Sub errorEnd(msg)
    Application.ScreenUpdating = True   'おまじない
    MsgBox msg
    End
End Sub

Private Sub testSpeed()
    Dim tictoc: tictoc = Timer()
    Dim sizeBuf:    sizeBuf = 1
    'Application.ScreenUpdating = False
    Call selection_makeFontBigger(sizeBuf)
    Application.ScreenUpdating = True
    tictoc = Format(Timer() - tictoc, "0.000")
    Debug.Print "sizeBuf=" & sizeBuf & " | " & Format(Selection.Count, "#,##0") & "セルを" & tictoc & "秒で実行"
End Sub