20180428 xlVBA自动设置成绩条行高
'自动设置行高 传入工作表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