Изменение шрифта относительно заполнения ячейки

Старая форма входа

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

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменение шрифта относительно заполнения ячейки (Макросы/Sub)

v_i_t_a_l_y_a

Дата: Понедельник, 16.05.2016, 15:25 | Сообщение № 1

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

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

Сообщений: 19

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

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

Excel 2010

Добрый день, пытаюсь создать скрипт для автоматического изменения размера шрифта в заданной ячейке.
Суть в том, что если у нас в ячейке до 11 символов - шрифт 26, если 12 - шрифт 25, если 13 - 23 и тд.
У меня работает следующая схема
[vba]

Код

    If Len(CStr(Cells(4, 2))) > 11 Then
           Cells(4, 2).Font.Size = 25
    End If
    If Len(CStr(Cells(4, 2))) > 12 Then
           Cells(4, 2).Font.Size = 23
    End If
    If Len(CStr(Cells(4, 2))) > 13 Then
           Cells(4, 2).Font.Size = 21
    End If
    If Len(CStr(Cells(4, 2))) > 14 Then
           Cells(4, 2).Font.Size = 20
    End If
    If Len(CStr(Cells(4, 2))) > 15 Then
           Cells(4, 2).Font.Size = 16
    End If
    If Len(CStr(Cells(4, 2))) > 20 Then
           Cells(4, 2).Font.Size = 12
    End If
    If Len(CStr(Cells(4, 2))) <= 11  Then
           Cells(4, 2).Font.Size = 26
    End If

[/vba]
Все отлично работает, но у меня есть две ячейки в которых размер должен быть одинаковым

например если в Cells(4, 2) - 3 символа, то шрифт стоит 26, а в Cells(5, 2)- символов больше 11, должен стать шрифт 25 в обоих ячейках, и наоборот если в первой больше символов чем во второй, шрифты должны изменятся одинаково.
Пытался сделать следующее
[vba]

Код

    If Len(CStr(Cells(4, 2))) > 11 Then
           Cells(4, 2).Font.Size = 25
    End If

    If Len(CStr(Cells(5, 2))) > 11 Then
           Cells(5, 2).Font.Size = 25
    End If

[/vba]
работает только последняя строка

так тоже не идет
[vba]

Код

    If Len(CStr(Cells(4, 2))) > 11 or Len(CStr(Cells(5, 2))) > 11 Then
          Cells(4, 2).Font.Size = 25
          Cells(5, 2).Font.Size = 25
    End If

[/vba]
Как быть?
[moder]Замечания исправлены[/moder]

Код

    If Len(CStr(Cells(4, 2))) > 11 Then
           Cells(4, 2).Font.Size = 25
    End If

    If Len(CStr(Cells(5, 2))) > 11 Then
           Cells(5, 2).Font.Size = 25
    End If

[/vba]
работает только последняя строка

так тоже не идет
[vba]

Код

    If Len(CStr(Cells(4, 2))) > 11 or Len(CStr(Cells(5, 2))) > 11 Then
          Cells(4, 2).Font.Size = 25
          Cells(5, 2).Font.Size = 25
    End If

[/vba]
Как быть?
[moder]Замечания исправлены[/moder]v_i_t_a_l_y_a

Сообщение отредактировал SLAVICK - Понедельник, 16.05.2016, 16:46

Ответить

СообщениеДобрый день, пытаюсь создать скрипт для автоматического изменения размера шрифта в заданной ячейке.
Суть в том, что если у нас в ячейке до 11 символов - шрифт 26, если 12 - шрифт 25, если 13 - 23 и тд.
У меня работает следующая схема
[vba]

Код

    If Len(CStr(Cells(4, 2))) > 11 Then
           Cells(4, 2).Font.Size = 25
    End If

    If Len(CStr(Cells(5, 2))) > 11 Then
           Cells(5, 2).Font.Size = 25
    End If

[/vba]
работает только последняя строка

так тоже не идет
[vba]

Код

    If Len(CStr(Cells(4, 2))) > 11 or Len(CStr(Cells(5, 2))) > 11 Then
          Cells(4, 2).Font.Size = 25
          Cells(5, 2).Font.Size = 25
    End If

[/vba]
Как быть?
[moder]Замечания исправлены[/moder]

Автор - v_i_t_a_l_y_a
Дата добавления - 16.05.2016 в 15:25

v_i_t_a_l_y_a

Дата: Понедельник, 16.05.2016, 16:40 | Сообщение № 2

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

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

Сообщений: 19

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

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

Excel 2010

В приложении пример файла

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

Ответить

Karataev

Дата: Понедельник, 16.05.2016, 16:49 | Сообщение № 3

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

Ранг: Старожил

Сообщений: 1334

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

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

Excel

[vba]

Код

Sub jjj()

    Dim lngMax As Long

    lngMax = WorksheetFunction.Max(Len(Cells(4, 2).Value), Len(Cells(5, 2).Value))

    Select Case lngMax
        Case Is > 20
            Cells(4, 2).Font.Size = 12
            Cells(5, 2).Font.Size = 12
        Case Is > 15
            Cells(4, 2).Font.Size = 16
            Cells(5, 2).Font.Size = 16
        Case Is > 14
            Cells(4, 2).Font.Size = 20
            Cells(5, 2).Font.Size = 20
        Case Is > 13
            Cells(4, 2).Font.Size = 21
            Cells(5, 2).Font.Size = 21
        Case Is > 12
            Cells(4, 2).Font.Size = 23
            Cells(5, 2).Font.Size = 23
        Case Is > 11
            Cells(4, 2).Font.Size = 25
            Cells(5, 2).Font.Size = 25
        Case Is <= 11
            Cells(4, 2).Font.Size = 26
            Cells(5, 2).Font.Size = 26
    End Select

End Sub

[/vba]

Ответить

v_i_t_a_l_y_a

Дата: Понедельник, 16.05.2016, 17:00 | Сообщение № 4

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

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

Сообщений: 19

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

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

Excel 2010

Спасибо, но при изменении любой ячейки из двух, мы должны получать одинаковый результат в обоих ячейках.
В Вашем варианте изменяется по разному размер шрифта в ячейках

Это тоже-самое, что и мой третий вариант.

Сообщение отредактировал v_i_t_a_l_y_a - Понедельник, 16.05.2016, 17:02

Ответить

RAN

Дата: Понедельник, 16.05.2016, 21:39 | Сообщение № 5

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

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

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

2010

[vba]

Код

Sub Мяу()
    Dim minmax&, cl As Range, fs&
    minmax = Len(Cells(4, 2)) - Len(Cells(5, 2))
    Set cl = IIf(minmax > 0, Cells(4, 2), Cells(5, 2))
    fs = 26
    If Len(cl) > 15 Then
        fs = 16
    ElseIf Len(cl) > 14 Then
        fs = 20
    ElseIf Len(cl) > 13 Then
        fs = 21
    ElseIf Len(cl) > 12 Then
        fs = 23
    ElseIf Len(cl) > 11 Then
        fs = 25
    End If
    Cells(4, 2).Font.Size = fs
    Cells(5, 2).Font.Size = fs
End Sub

[/vba]

Быть или не быть, вот в чем загвоздка!

Ответить

v_i_t_a_l_y_a

Дата: Вторник, 17.05.2016, 07:56 | Сообщение № 6

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

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

Сообщений: 19

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

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

Excel 2010

Спасибо, большое! Сделал по Вашему коду для двух ячеек где нужны идентичные параметры, и по своему для самостоятельных ячеек.

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменение шрифта относительно заполнения ячейки (Макросы/Sub)

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