макрос для увеличения высоты строки

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

макрос для увеличения высоты строки (Макросы/Sub)

Литр

Дата: Пятница, 28.11.2025, 08:48 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

20213

Добра всем.

Прошу помощи: нужен макрос для диапазона ячеек страницы который автоматически увеличивает высоту строки в зависимости от введненного текста внутри.
Например: Иванов Иван Иванович - 20 пикс,

Иванов
Иван
Иванович - 60 пикс.

Есть такая заготовка, нужно добавить команду:

[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("F2:G1000", "K2:L1000")) Is Nothing Then
' макрос увеличения строки
End If
End Sub

[/vba]

Заранее благодарю

Сообщение отредактировал Литр - Пятница, 28.11.2025, 13:13

Ответить

MikeVol

Дата: Пятница, 28.11.2025, 22:42 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 460

Репутация: 110 ±

Замечаний: 0% ±

MSO LTSC 2021 EN

[vba]

Код

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ExitHandler
    Application.EnableEvents = False

    Dim rng         As Range
    Set rng = Me.Range("F2:G1000,K2:L1000")

    If Target.CountLarge = 1 Then

        If Not Intersect(Target, rng) Is Nothing Then
            AutoFitRow Target
        End If

    End If

ExitHandler:
    Application.EnableEvents = True
End Sub

Private Sub AutoFitRow(ByVal cell As Range)
    Dim r           As Long
    r = cell.Row

    With Rows(r)
        .AutoFit

        If .RowHeight < 20 Then .RowHeight = 20
        If .RowHeight > 120 Then .RowHeight = 120
    End With

End Sub

[/vba]Как вариант

Ученик.
Одесса - Украина

Ответить

Литр

Дата: Суббота, 29.11.2025, 17:07 | Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

20213

MikeVol, hands

Спасибо, работает замечательно, даже на защищенном листе. Как и планировалось.

Можно ли добавить такой код: что бы при копировании в контролируемые ячейки из буфера вставлялось только содержимое без форматов. По аналогии "специальная вставка.... / Значения"

Сообщение отредактировал Литр - Суббота, 29.11.2025, 17:08

Ответить

MikeVol

Дата: Суббота, 29.11.2025, 17:53 | Сообщение № 4

Группа: Проверенные

Ранг: Обитатель

Сообщений: 460

Репутация: 110 ±

Замечаний: 0% ±

MSO LTSC 2021 EN

Цитата Литр, 29.11.2025 в 17:07, в сообщении № 3 (

)

По аналогии "специальная вставка.... / Значения"

Пробуйтее: [vba]

Код

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ExitHandler
    Application.EnableEvents = False

    Dim rng         As Range
    Set rng = Me.Range("F2:G1000,K2:L1000")

    If Target.CountLarge = 1 Then

        If Not Intersect(Target, rng) Is Nothing Then

            If Target.HasFormula = False Then
                Target.Value = Target.Value
            End If

            AutoFitRow Target
        End If

    End If

ExitHandler:
    Application.EnableEvents = True
End Sub

Private Sub AutoFitRow(ByVal cell As Range)
    Dim r           As Long
    r = cell.Row

    With Rows(r)
        .AutoFit

        If .RowHeight < 20 Then .RowHeight = 20
        If .RowHeight > 120 Then .RowHeight = 120
    End With

End Sub

[/vba]

Ученик.
Одесса - Украина

Ответить

MikeVol

Дата: Суббота, 29.11.2025, 17:55 | Сообщение № 5

Группа: Проверенные

Ранг: Обитатель

Сообщений: 460

Репутация: 110 ±

Замечаний: 0% ±

MSO LTSC 2021 EN

del (duplicate)

Ученик.
Одесса - Украина

Сообщение отредактировал MikeVol - Суббота, 29.11.2025, 17:55

Ответить

макрос для увеличения высоты строки (Макросы/Sub)

Страница 1 из 1
1