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

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

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

Литр

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

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

Ранг: Новичок

Сообщений: 18

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

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

2013

Добра всем.

Прошу помощи: нужен макрос для диапазона ячеек страницы который автоматически увеличивает высоту строки в зависимости от введненного текста внутри.
Например: Иванов Иван Иванович - 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

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

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

Сообщений: 464

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

Замечаний: 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

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

Ранг: Новичок

Сообщений: 18

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

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

2013

MikeVol, hands

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

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

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

Ответить

MikeVol

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

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

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

Сообщений: 464

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

Замечаний: 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]

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

Ответить

Литр

Дата: Воскресенье, 30.11.2025, 01:40 | Сообщение № 5

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

Ранг: Новичок

Сообщений: 18

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

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

2013

MikeVol, немного не то, возможно не так поставил вопрос.
Имелось ввиду не вставка значения вместо формулы, а вставка только текста без форматов. Игнорировать полужирный, подчеркнутый, рамки, атрибуты размера и типа шрифта и прочие. То есть пользователь копирует из word или из другого источника (не важно) некий текст, и этот текст должен быть вставлен сохранив формат ячейки в которую его пытаются вставить, в моем случае это диапазон ("F2:G1000,K2:L1000")

Ответить

MikeVol

Дата: Воскресенье, 30.11.2025, 10:06 | Сообщение № 6

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

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

Сообщений: 464

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

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

MSO LTSC 2021 EN

Литр, Понял вас теперь: [vba]

Код

Option Explicit

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

    If Target.CountLarge = 1 Then

        If Not Intersect(Target, Me.Range("F2:G1000,K2:L1000")) Is Nothing Then
            Target.ClearFormats
            Target.Value = Target.Value
            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]

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

Ответить

Литр

Дата: Воскресенье, 30.11.2025, 14:28 | Сообщение № 7

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

Ранг: Новичок

Сообщений: 18

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

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

2013

MikeVol, извините, но опять не то
В этом случае очищается формат из ячейки куда будет вставлено значение из буфера, а нужно что бы сохранялся формат конечной ячейки, а ctrl+v вставляло только тест либо дату либо формулу либо что угодно другое но без изменения формата конечной ячейки. Прицепил файл с примером

К сообщению приложен файл: sokhran_formata_konechnoj_jach.xlsm (19.7 Kb)

Ответить

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

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