zoukankan      html  css  js  c++  java
  • 20190316xlVba_设置行高的改进方案

    Public Sub AutoSetRowHeight(ByVal sht As Worksheet, Optional RowsInOnePage As Long)
        Dim BreakRow As Range '水平分页符位置
        Dim SumHeight As Double '累计首页行高
        Dim AverageHeight As Double
        Dim RestHeight 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
            Debug.Print "计算行号尾号  "; i - 1
            '获取第一页最后一个成绩单末尾的空白行行号
            If IsMissing(RowsInOnePage) Then
                RowsInOnePage = BreakRow.Row
                Do While .Cells(RowsInOnePage, 2).Value <> ""
                    RowsInOnePage = RowsInOnePage - 1
                Loop
                Debug.Print "首页最后一个成绩单截止行号:"; RowsInOnePage
            End If
            '计算平均行高
            Debug.Print "单页总行高 : "; SumHeight
            If RowsInOnePage <> 0 Then
                AverageHeight = SumHeight / RowsInOnePage
            Else
                MsgBox "除零错误"
                'GoTo ErrHandler
                Exit Sub
            End If
            '设置已用区域的行高
            'AverageHeight = IIf(AverageHeight - Int(AverageHeight) > 0.5, Int(AverageHeight) + 1, Int(AverageHeight) + 0.5)
            
            
            
            
            '########################
            '行高最小设置单位为0.25 改进方案,现将N-1行缩小一点,再将第N行放大一点
            AverageHeight = Int(AverageHeight / 0.25) * 0.25 '截取0.25的倍数部分
            RestHeight = SumHeight - AverageHeight * (RowsInOnePage - 1)
            .UsedRange.Rows.RowHeight = AverageHeight
            
            EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
            For i = 1 To EndRow
                If i Mod RowsInOnePage = 0 Then .Rows(i).RowHeight = RestHeight
            Next i
            
            
            '首页仍然后剩余 进入调整方案
            Set BreakRow = sht.HPageBreaks(1).Location
            FirstEnd = BreakRow.Row - 1
            
            If FirstEnd > RowsInOnePage Then
                Do While .Cells(FirstEnd, 1).Value <> ""
                    For i = FirstEnd To 1 Step -1
                        If .Cells(i, 1).Value = "" Then
                            lastBlank = i
                            Exit For
                        End If
                    Next i
                    NewHeight = .Rows(lastBlank).RowHeight + 0.25
                    .Rows(lastBlank).RowHeight = NewHeight
                    Set Rng = sht.HPageBreaks(1).Location
                    FirstEnd = Rng.Row - 1
                Loop
                EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
                For i = 1 To EndRow
                    If i Mod RowsInOnePage = 0 Then .Rows(i).RowHeight = NewHeight
                Next i
            End If
            
        End With
        '释放
        Set sht = Nothing
        Set BreakRow = Nothing
    End Sub
    

      

  • 相关阅读:
    vue中$refs、$slot、$nextTick相关的语法
    js中hash、hashchange事件
    js中filter的用法
    ES6新特性-函数的简写(箭头函数)
    js中把ajax获取的数据转化成树状结构(并做成多级联动效果)
    jq中get()和eq()的区别
    new Date() 日期格式处理
    微信小程序 加载图片时,先拉长,再恢复正常
    一个例子理解ES6的yield关键字
    eclipse在光标停留在同一对象的背景色提示,开启与关闭
  • 原文地址:https://www.cnblogs.com/nextseven/p/10543429.html
Copyright © 2011-2022 走看看