趣味プログラミングblog

高さの自動調整を使った後にフォントサイズを小さくすると、
小さくしたフォント分だけ高さが小さくなる。

高さの自動調整をすると、手動で高さを設定するまで自動調整が有効になるんだとか。

複数行の高さを全部記憶して戻すのはだるいなぁと考えたものの
高さの自動調整を解除してやればいいことに気付く。

解除方法は、RowHeight に値を設定だけでいいらしい。
https://www.tipsfound.com/vba/08010

---

エクセルが印刷時に見切れるのは、印刷フォントが表示フォントより大きいせいだけど、
横幅だけじゃなくて高さも大きかったのね。

Range変数rを定義して、対象の行をfor Eachで回す。

高さの設定は、r.RowHeight = r.RowHeightでOK。
（r.Heightではオブジェクトがありませんって怒られる）

今度こそ解決！！


以下、ソース。ソーステキストは、 こちらからダウンロード。

---

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 '行の高さを自動調節
Dim r As range
For Each r In Rows(strRows)
r.RowHeight = r.RowHeight
Next r
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