Автовысота в MergeCells

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
     ' Auto adjust cell size for comment fields
    Dim RowHt As Single, MergeWidth As Single
    Dim C As Range, AutoFitRng As Range
    Dim CWidth As Single, NewRowHt As Single
    Static OldRngAdd As String
    Dim OldRng As Range
    On Error Resume Next
    If bDisableEvents Then Exit Sub
    If OldRngAdd = "" Then
        Set OldRng = Union(Range("CommentRange1").MergeArea, Range("CommentRange2").MergeArea)
        OldRngAdd = OldRng.Address
    Else
        Set OldRng = Range(OldRngAdd)
    End If
    Set AutoFitRng = Union(Range("CommentRange1"), Range("CommentRange2"))
    If Not Intersect(OldRng, AutoFitRng) Is Nothing Then
        Application.ScreenUpdating = False
        With OldRng
            RowHt = .RowHeight
            CWidth = .Cells(1).ColumnWidth
            For Each C In OldRng
                MergeWidth = C.ColumnWidth + MergeWidth
            Next
            .MergeCells = False
            .Cells(1).ColumnWidth = MergeWidth
            .EntireRow.AutoFit
            NewRowHt = .RowHeight * 0.7
            .Cells(1).ColumnWidth = CWidth
            .MergeCells = True
            .RowHeight = NewRowHt
            .Locked = False
        End With
        Application.ScreenUpdating = True
    End If
    OldRngAdd = Target.Address
End Sub

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *