Страницы: 1
RSS
Автоматическое выравнивание конткетных строк по высоте
 
Здравствуйте. Подскажите, пожалуйста. Где-то в интернете я нашел, макрос который выравнивает высоту строк, но он выравнивает для всего листа, а что нужно подправить, чтобы он выравнивал, конкретные строки. Например, с 9 по 72 и с 147 по 183.
 
После
For Each ro In ra.Rows
считаете количество обработанных строк, анализируете полученное значение счётчика, по результату обрабатываете или нет очередную строку.
 
А можно пример
 
Код
Sub Макрос1()
    Application.ScreenUpdating = False
    Rows("9:72").AutoFit
    Rows("147:183").AutoFit
    Application.ScreenUpdating = True
End Sub

если нужно просматривать строки,чтобы принять решение -изменять или нет высоту строк,то такой скрипт:
Код
Sub Макрос1()
    Dim i As Long
    Application.ScreenUpdating = False
    For i = 9 To 72
        Rows(i).AutoFit
    Next
    For i = 147 To 183
        Rows(i).AutoFit
    Next
    Application.ScreenUpdating = True
End Sub
Изменено: Karataev - 04.03.2015 14:33:20
 
Ваш код не совсем подходит потому что он работает, только не для объеденных  ячеек. А у меня ячейки объдененны например с A9 по E152.
 
не смогу вам помочь,т.к. я  делаю макросы только  по текстовому описанию.
делать макрос по другим макросам для меня  сложно

подождите,может кто-нибудь  другой поможет
 
Спасибо и на этом
 
Как подсказал. Но без проверки.
Код
Sub Visota(ByRef ra As Range)
    Dim CurrCell As Range, cell As Range, ma As Range: Dim col As Range, ro As Range, sc As Long
    For Each ro In ra.Rows
        sc = sc + 1
        Select Case sc
        Case 9 To 72, 147 To 183
            maxRH = 0
            For Each cell In ro.Cells
                If cell.MergeCells And cell.Address = cell.MergeArea.Cells(1).Address Then
                    Debug.Print cell.Address
                    Set ma = cell.MergeArea: newCW = 0
                    With ma
                        cw = .Columns(1).ColumnWidth: .UnMerge
                        For Each col In .EntireColumn: newCW = newCW + col.ColumnWidth: Next
                        .Columns(1).ColumnWidth = newCW: .EntireRow.AutoFit
                        rh = .EntireRow.RowHeight: If rh > maxRH Then maxRH = rh
                        .Merge: .Columns(1).ColumnWidth = cw
                    End With
                End If
            Next cell
            If maxRH > 0 Then ro.EntireRow.RowHeight = maxRH
        End Select
    Next ro
End Sub
 
Спасибо большое все работает.
 
Я, в интернете нашел ещё несколько макросов + пример Hugo, так кому будет интересно, но они работают, только для объеденных ячеек.
Страницы: 1
Наверх