印刷するとセル内の文字列が隠れてしまう問題をどうにかしたい

問題点

昔から気になっていたが、なぜか印刷設定すると、セル内の文字列が隠れてしまう問題がある。
これについては、これまで改行を数行打ち込む面倒なことをしていました。
今回は、マクロでアプローチしてみます。

解決方法

選択されたセル内の改行数をチェックして、いい感じの高さにします。
これにより、印刷設定しても、文字が隠れないと思います。
※選択範囲は１列選択を前提にしています。
以下サンプル。

Const MAXCOUNT As Integer = 5000

Sub AdjustCellHeight()
    Dim selectedRange As Range
    Dim cell As Range
    Dim defaultHeight As Double
    Dim linecount As Integer
    
    Dim LimitCount As Integer
    
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    ' 選択されたセル範囲を取得
    Set selectedRange = Selection
    
    ' デフォルトのセルの高さを取得
    defaultHeight = selectedRange.Worksheet.StandardHeight
       
    ' 選択された各セルに対してループ
    For Each cell In selectedRange
        ' セル内の改行数を取得
        linecount = CountLineBreaks(cell)
        
        ' 結合されたセルの場合は結合セル内の各セルの高さを調整
        If cell.MergeCells Then
            Dim mergedRange As Range
            Set mergedRange = cell.MergeArea
            Dim mergedCell As Range
            
            ' 結合セル内の各セルに対してループ
            For Each mergedCell In mergedRange
                ' セルの高さを設定
                If linecount > 1 Then
                    ' 改行数が1より大きい場合、改行数に応じて適切な高さを設定
                    mergedCell.RowHeight = defaultHeight + (linecount - 1) * defaultHeight
                    Exit For
                End If
            Next mergedCell
        Else
            ' 結合されていない場合は通常のセルの高さを設定
            If linecount > 1 Then
                ' 改行数が1より大きい場合、改行数に応じて適切な高さを設定
                cell.RowHeight = defaultHeight + (linecount - 1) * defaultHeight
            Else
                ' 改行がない場合はデフォルトの高さに設定
                cell.RowHeight = defaultHeight
            End If
        End If
        
        If (LimitCount = MAXCOUNT) Then
            Exit For
        End If
        LimitCount = (LimitCount + 1)
    Next cell
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "選択したセル範囲を、改行数に応じてセル高さを調整しました", vbInformation
    
End Sub

Function CountLineBreaks(cell As Range) As Integer
    Dim text As String
    Dim lines() As String
    Dim linecountCRLF As Integer
    Dim linecountLF As Integer
    Dim linecount As Integer
    ' 対象セルのテキストを取得
    text = cell.Value
    ' 改行でテキストを分割
    lines = Split(text, vbCrLf)
    linecountCRLF = UBound(lines)
    ' 改行でテキストを分割
    lines = Split(text, vbLf)
    linecountLF = UBound(lines)
    ' 改行コード数を積算
    linecount = (linecountLF + linecountCRLF)
    ' 分割された行数を返す
    CountLineBreaks = linecount + 1
End Function