20180428 xlVBA自动设置成绩条行高

Posted 2020-11-01 Excel VBA 小天地

‘自动设置行高  传入工作表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