‘自動設置行高  傳入工作表Sht 和 每頁打印的行數RowsInOnePage
Public Sub AutoSetRowHeight(ByVal Sht As Worksheet, Optional RowsInOnePage As Variant)
    Dim BreakRow As Range ‘水平分頁符位置
    Dim SumHeight As Double ‘累計首頁行高
    Dim AverageHeight As Double
    Dim i As Long ‘行號
    With Sht
        ‘獲取第一頁與第二頁分頁符所在的單元格
        Set BreakRow = Sht.HPageBreaks(1).Location
        Debug.Print "首頁分頁符所在的行號："; BreakRow.Row
        ‘累計第一頁所有行的高度
        i = 1
        Do While i < BreakRow.Row
            SumHeight = SumHeight + .Rows(i).RowHeight
            i = i + 1
        Loop
        ‘獲取第一頁最後一個成績單末尾的空白行行號
        If IsMissing(RowsInOnePage) Then
            RowsInOnePage = BreakRow.Row
            Do While .Cells(RowsInOnePage, 2).Value <> ""
                RowsInOnePage = RowsInOnePage - 1
            Loop
            Debug.Print "首頁最後一個成績單截止行號："; RowsInOnePage
        End If
        ‘計算平均行高
        If RowsInOnePage <> 0 Then
            AverageHeight = SumHeight / RowsInOnePage
        Else
            MsgBox "除零錯誤"
            Exit Sub
        End If
        ‘設置已用區域的行高
        .UsedRange.Rows.RowHeight = AverageHeight
    End With
    ‘釋放
    Set Sht = Nothing
    Set BreakRow = Nothing
End Sub

20180428 xlVBA自動設置成績條行高