横方向に結合したセルの高さを自動調節する

'横方向に結合したセルの高さを自動調節する
'
' 処理の概要
' - 新しいブックを作成し、書式、標準のフォントとそのサイズを選択したセル範囲からコピー
'   (標準のフォントの大きさによって長さ当たりのピクセル数が変わってくるので標準のフォントを揃えること重要)
' - 結合したセルの値をテスト用のセルにコピーする、テスト用のセルを結合後の幅に揃えたうえでAutoFitする。
' - テスト用セルの高さと同じ高さに結合したセルの高さを設定する。

Sub AutoFitMergedCells()
    
    '自動調節したいセル範囲、ブック等を変数に格納 =>TargetBook
    Dim TargetBook As Workbook
    Dim TargetRows As Range
    Set TargetRows = Selection.Rows
    Set TargetBook = TargetRows.Worksheet.Parent
    Dim NormalFontName As String
    NormalFontName = TargetBook.Styles("Normal").Font.Name ' 後で取得するとなぜかMSゴシックが返ってくるので最初に取得しておく
    Dim NormalFontSize As Double
    NormalFontSize = TargetBook.Styles("Normal").Font.Size
    
    
    '高さを調べるためのテスト用ブックの用意 =>TestBook
    '
    Dim TestBook As Workbook
    Set TestBook = Workbooks.Add
    Dim TestSheet As Worksheet
    Set TestSheet = TestBook.Worksheets(1)
    
    Dim TestCell As Range
    Set TestCell = TestSheet.Cells(1, 1)
    
    TestBook.Styles("Normal").Font.Name = NormalFontName
    TestBook.Styles("Normal").Font.ThemeFont = xlThemeFontNone
    TestBook.Styles("Normal").Font.Size = NormalFontSize

    
    Dim Row As Range
    For Each Row In TargetRows

        Dim MergedCells As Range
        Set MergedCells = Row
        
        Dim MergedWidth As Double
        MergedWidth = 0
        Dim Col
        For Each Col In MergedCells.Areas(1).Columns
            MergedWidth = MergedWidth + Col.ColumnWidth
        Next
        MergedWidth = MergedWidth
        MergedCells.Copy
        TestSheet.Paste TestCell

        TestCell.MergeCells = False
        TestCell.ColumnWidth = MergedWidth
        TestCell.Value = MergedCells.Value
        
        TestCell.EntireRow.AutoFit
        MergedCells.RowHeight = TestCell.RowHeight
    Next
End Sub