20180428 xlVBA自动设置成绩条行高

'自动设置行高
Sub AutoSetRowHeight()
    Dim BreakRow As Range '水平分页符位置
    Dim Wb As Workbook
    Dim Sht As Worksheet
    Dim SumHeight As Double '累计首页行高
    Dim AverageHeight As Double
    Dim FirstPageLastRow As Long '首页末行行号
    Dim i As Long '行号
    Set Wb = Application.ThisWorkbook
    Set Sht = Wb.ActiveSheet
    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
        '获取第一页最后一个成绩单末尾的空白行行号
        i = BreakRow.Row
        Do While .Cells(i, 2).Value <> ""
            i = i - 1
        Loop
        Debug.Print "首页最后一个成绩单截止行号:"; i
        '计算平均行高
        If i <> 0 Then
            AverageHeight = SumHeight / i
        Else
            MsgBox "除零错误"
            Exit Sub
        End If
        '设置已用区域的行高
        .UsedRange.Rows.RowHeight = AverageHeight
    End With
    '释放
    Set Wb = Nothing
    Set Sht = Nothing
    Set BreakRow = Nothing
End Sub

  

猜你喜欢

转载自www.cnblogs.com/nextseven/p/8969570.html