如果单元格最大,如何仅自动调整行高?

时间:2017-04-26 13:37:49

标签: vba excel-vba excel

我有很多行基于两列“A”和& “我”在工作表事件更改时,将自动调整该行。我的代码在一行/列上工作正常,但是当另一行/列小于前一行/列时,初始行/列高度会随着最后一行/列而缩小。我需要帮助,如果在工作表事件更改,如果最大高度已经不存在自动调整。

Sub AutoFitMergedCellRowHeight(Target As String)
    Dim MergeWidth As Single
    Dim cM As Range
    Dim AutoFitRng As Range
    Dim CWidth As Double
    Dim NewRowHt As Double
    Application.ScreenUpdating = False
    On Error Resume Next
    Set AutoFitRng = Range(Target)

    With AutoFitRng
        ActiveSheet.Unprotect Password:="410"
        .MergeCells = False
        CWidth = .Cells(1).ColumnWidth
        MergeWidth = 0
        For Each cM In AutoFitRng
            cM.WrapText = True
            MergeWidth = cM.ColumnWidth + MergeWidth
        Next
        'small adjustment to temporary width
        MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
        .Cells(1).ColumnWidth = MergeWidth
        .EntireRow.AutoFit
        NewRowHt = .RowHeight
        .Cells(1).ColumnWidth = CWidth
        .MergeCells = True
        .RowHeight = NewRowHt
        ActiveSheet.Protect Password:="410"
    End With
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer

    For i = 12 To 417
        If Target.Address = "$A$" & i Then
            Call AutoFitMergedCellRowHeight(Target.MergeArea.Address)
        End If

        If Target.Address = "$I$" & i Then
            Call AutoFitMergedCellRowHeight(Target.MergeArea.Address)
        End If
    Next i

0 个答案:

没有答案