Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA, изменения размера шрифта в защищённой ячейке
 
#1
15.02.2021 13:09:27
Здравствуйте
Есть скрипт, который в зависимости от количества символов в ячейке меняет размер шрифта. С файлом работает очень много людей и чтобы не повредили файл многие ячейки защищены от изменений. Как сделать чтобы в защищённой ячейке скриптом менялся шрифт?
Код
Private Sub Worksheet_Calculate()
    With Range("D17")
        If Len(.Text) < 8 Then
            .Font.Size = 25
        ElseIf Len(.Text) < 9 Then
            .Font.Size = 23
        ElseIf Len(.Text) < 10 Then
            .Font.Size = 21
        ElseIf Len(.Text) < 11 Then
            .Font.Size = 19
        ElseIf Len(.Text) < 12 Then
            .Font.Size = 17
        ElseIf Len(.Text) < 13 Then
            .Font.Size = 15
        ElseIf Len(.Text) < 14 Then
            .Font.Size = 14
        ElseIf Len(.Text) < 15 Then
            .Font.Size = 13
        Else
            .Font.Size = 12
        End If
    End With
End Sub
 
 
 
#2
15.02.2021 13:14:21
В начале макрос снимаем защиту, после изменения шрифта ставим.
Unprotect/Protect
 
 
 
#3
15.02.2021 13:18:49
Альтернатива - при открытии файла защищаем лист методом Protect c параметром UserInterfaceOnly:=True
Изменено: sokol92 - 15.02.2021 13:19:01
Владимир
 
 
 
#4
15.02.2021 14:05:25
Подскажите пожалуйста, как правильно скрипт внутри защиты прописать. Не хватает понимания, мои попытки приводят к ошибкам
Код
Sub Write_in_ProtectSheet()
    Worksheets("Лист").Unprotect Password:="123"
        Private Sub Worksheet_Calculate()
            With Range("D17")
                If Len(.Text) < 8 Then
                    .Font.Size = 25
                Else
                    .Font.Size = 12
                End If
            End With
        End Sub
    Worksheets("Лист").Protect Password:="123"
End Sub
Изменено: Locko - 15.02.2021 14:05:48
 
 
 
#5
15.02.2021 14:09:00
Не может бть процедуры Sub в процедуре Sub
Код
Private Sub Worksheet_Calculate()
      Worksheets("Лист").Unprotect Password:="123"
 
 
 
#6
15.02.2021 14:24:41
Поставьте в формате ячейки D17 Выравнивание / автоподбор ширины и макрос будет не нужен.
Владимир
 
 
 
#7
15.02.2021 14:31:03
vikttur,  Спасибо, всё получилось

Код
Private Sub Worksheet_Calculate()
Worksheets("Лист").Unprotect "123"
    With Range("D17")
        If Len(.Text) < 8 Then
            .Font.Size = 25
        Else
            .Font.Size = 12
        End If
    End With
    Worksheets("Лист").Protect "123"
End Sub

sokol92, область печати имеет определённые границы, поэтому данный вариант не подойдёт.
Изменено: Locko - 15.02.2021 14:31:22
 
 
 
#8
15.02.2021 14:38:41
"Автоподбор ширины" касается подбора размера шрифта под размер ячейки, а не изменение ширины ячейки. Попробуйте!
Владимир
 
 
 
#9
15.02.2021 15:17:40
sokol92,спасибо! Не знал о такой возможности, очень удобно но есть один минус и для меня он очень существенный. При автоподборе размер шрифта ниже, чем можно сделать на самом деле. Для примера, в ячейке при 7-ми значном артикуле, на автоподборе размер шрифта 19 пт., при ручной регулировке или через скрипт 27 пт. полностью отображается.
 
 
 
#10
15.02.2021 15:21:56
Автоподбор не увеличивает, а только уменьшает. В Вашем примере нужно изначально выставить шрифт 27 пт. а после этого перейти на автоподбор. У Вас после этого шрифт уменьшается до 19? Выложите, пожалуйста, пример.
Владимир
 
 
 
#11
15.02.2021 16:03:46
sokol92, полагаю у меня частный случай. К ячейке D17 примените автоподбор и увидите уменьшение размера шрифта
 
 
 
#12
15.02.2021 16:25:29
Да, чуть уменьшает. Может быть, из-за (невидимых) внутренних границ ячеек (не уверен).
Изменено: sokol92 - 15.02.2021 16:26:26
Владимир
 
 
 
Страницы: 1
Наверх