Событие для изменения размера шрифта, если счетчик символов больше 100

Question

У меня есть эта функция, когда в любое время ячейка внутри определенного диапазона вызывает функцию.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:L60")) Is Nothing Then
    Call fit_text
    End If
End Sub

Функция fit_text изменяет размер шрифта значения активной ячейки.

Sub fit_text()
    MsgBox ActiveCell.Characters.Count

    If ActiveCell.Characters.Count > 100 Then
        ActiveCell.Font.Size = 8
    Else
        ActiveCell.Font.Size = 10
    End If
End Sub

ПРОБЛЕМА: всякий раз, когда я изменяю значение ячейки, в которой количество символов превышает 100, размер шрифта остается равным 10, а в окне сообщения, в котором указывается значение счетчика, отображается 0, но всякий раз, когдаЯ запускаю его на VBA, окно сообщения показывает правильное значение и изменяет размер шрифта, если число больше 100. Мне нужно, чтобы оно было автоматическим.Невозможно изменить высоту или ширину ячеек

Answer 1

Обратите внимание, что Excel может автоматически уменьшить размер шрифта, чтобы он поместился в ячейку. Поэтому выберите свою ячейку, нажмите Ctrl + 1 , перейдите на вкладку Alignment и выберите Shrink To Fit.

.

---

Чтобы исправить ваш код:
Не используйте ActiveCell. Вместо этого используйте Target или диапазон Intersect. ActiveCell не может быть ячейкой, которая была изменена. Кроме того, Target может состоять из нескольких ячеек, поэтому вам нужно пройтись по всем измененным ячейкам и проверить каждую ячейку отдельно.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim AffectedRange As Range
    Set AffectedRange = Intersect(Target, Target.Parent.Range("A1:L60"))

    If Not AffectedRange Is Nothing Then
        Dim Cell As Range
        For Each Cell In AffectedRange 'loop through all changed cells
            MsgBox Len(Cell.Value)

            If Len(Cell.Value) > 100 Then
                Cell.Font.Size = 8
            Else
                Cell.Font.Size = 10
            End If
        Next Cell
    End If
End Sub

Answer 2

Проблема в 'ActiveCell'.

Например, когда вы редактируете ячейку A1 и нажимаете ввод, ActiveCell, который вы используете в fit_text, не A1, а A2.

Однако это легко исправить, просто передав ячейку из Worksheet_Change в fit_text.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:L60")) Is Nothing Then
        'Pass the Target to 'fit_text'
        Call fit_text(Target)
    End If
End Sub

Sub fit_text(Cell)
    'Instead of using ActiveCell, use Cell (which is the passed Target)
    MsgBox Cell.Characters.Count

    If Cell.Characters.Count > 100 Then
        Cell.Font.Size = 8
    Else
        Cell.Font.Size = 10
    End If
End Sub

Answer 3

ActiveCell является активным после события изменения.Вы можете передать Target из события в ваш метод fit_text, чтобы он всегда ссылался на измененные ячейки:

Private Sub Worksheet_Change(ByVal target As Range)
 If Not Intersect(target, Range("A1:L60")) Is Nothing Then
    Call fit_text(target)
    End If
End Sub


Sub fit_text(target As Range)
    MsgBox ActiveCell.Address(False, False)
    MsgBox target.Characters.Count

'    If ActiveCell.Characters.Count > 100 Then
'        ActiveCell.Font.Size = 8
'    Else
'        ActiveCell.Font.Size = 10
'    End If

If target.Characters.Count > 100 Then
        target.Font.Size = 8
    Else
        target.Font.Size = 10
    End If
End Sub

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