Excelの結合セルでも行高さを自動調整できるマクロ（VBA）

Excelには自動高さ調節の機能があって、［セルの書式設定］→［配置］タブ→［文字の制御］で「折返して全体を表示する」に設定してあれば、１つのセルに長い文章を入力したり、［Alt］＋［Enter］で改行したとき、自動的にセルの高さを調整してくれます。
ただし、TrueTypeフォントを使っている場合は、印刷すると文章の最後の方が隠れて見えなくなることがあります。
（等幅フォントは見た目が悪いため、通常はTrueTypeフォントを使っていると思います）
また、セルが結合されていると、この自動高さ調整が効かなくなります。

このような場合は、手動で１行ずつ行高さを調節して、文章が隠れないように高さを調整するしかありませんが、それはけっこう面倒だと思います。
それを簡単にするマクロ（VBAプログラム）を紹介します。
このマクロは複数のセルを指定して、一度に調節することもできるので、複数の行を選択して一気に高さを調節することも可能です。

下のプログラムをコピーして、EXCEL VBA のモジュールに貼り付ければ使えます。
Personal.xlsb（個人用マクロブック）に保存しておくと、どのブック上でも使えて便利です。

Personal.xlsbに保存する方法は、こちら↓
　Excel マクロを個人用マクロブックに保存して共通マクロとして使用する
また、ショートカットキー（［Ctrl］＋［Shift］＋［H］など）を設定しておくと、さらに便利です。

Sub 行高自動調整()
  Dim シート名, Message1, Title1 As String
  Dim 対象シート As Worksheet
  Set 対象シート = ActiveSheet
  シート名 = ActiveSheet.Name

  '作業用シート追加
  Dim 作業ブック As Workbook, 作業シート As Worksheet, 作業セル As Range
  Application.ScreenUpdating = False
  Set 作業ブック = Workbooks.Add
  Set 作業シート = 作業ブック.Worksheets("Sheet1")
  Set 作業セル = 作業シート.Range("A1")
     
  対象シート.Activate
  Set 対象シート = Nothing
    
  Dim 対象範囲 As Range, 対象セル As Range, 行数 As Integer
  Set 対象範囲 = Selection
  行数 = 対象範囲.Cells(1).Row - 1
  For Each 対象セル In 対象範囲
    If 対象セル.Row <> 行数 Then
      対象セル.Select
      If Selection.Cells.Count <> 1 Then
        Call FitRows(Selection, 作業セル)
        行数 = 行数 + Selection.Rows.Count
      Else
        With 対象セル
          .WrapText = True
          .EntireRow.AutoFit
        End With
        行数 = 対象セル.Row
      End If
    End If
  Next 対象セル
    
  '作業用シート削除
  Application.DisplayAlerts = False
  作業ブック.Close False
  Application.DisplayAlerts = True
  Set 作業ブック = Nothing
  Set 作業シート = Nothing
  Set 対象範囲 = Nothing
  
  Application.ScreenUpdating = True

End Sub
Private Sub FitRows(rngSrc As Range, cellDest As Range)
  
  With rngSrc
    .WrapText = True
    .Copy Destination:=cellDest
  End With
    
  Dim Wid As Single, Hei As Single
  Dim 対象セル As Range
  For Each 対象セル In rngSrc.Rows(1).Cells
    Wid = Wid + 対象セル.ColumnWidth
  Next 対象セル
  Wid = Wid + 0.2
    
  With cellDest
    .UnMerge
    .ColumnWidth = Wid
    .EntireRow.AutoFit
    Hei = .Height + 5
  End With
  rngSrc.Cells(1).RowHeight = Hei

End Sub

このマクロはほとんどの場合でうまく高さが調整できますが、1行の長さが印刷時に見切れる長さの行が、［Alt］＋［Enter］で改行して複数あるという条件の時には、末尾が見切れてしまうことがあります。
印刷時に見切れてしまう部分がないか、念のためプリビューで確認してください。

このマクロは私が作ったものではなくて、ずいぶん昔にどこかのQ＆A掲示板で見つけたものを、少しだけ変更したものです。
（変更したのは、変数の一部を日本語にしただけだったと思います）
出所を探してみたのですが、サイトがなくなったのか、見つかりませんでした。
もし知っている人がいたら、教えてください。

【2020年8月20日追記】
Excel2019では行高さが高くなりすぎてしまいます。
マクロを調整して対応しようと試みましたが、どこかで見つけたもの（自分で作ったものではない）なので、調整できませんでした。
代わりに、Excel2019でもできるものを見つけました。↓
　結合したセルの高さを自動調整する: やむえむのExcel VBAメモ

このマクロで高さ調整すると、セルの高さに文字がビッタリになります。
少し上下に余裕が欲しいときは、マクロの最後の方にある
「.RowHeight = sh1.Cells(1, 1).RowHeight」の末尾に、
「 + 10」を加えて、
「.RowHeight = sh1.Cells(1, 1).RowHeight + 10」とすると、
適当な余白ができます。

「 + 10」の数字は、お好みで変えてみてください。