Условное форматирование с использованием блока UDF Worksheet_change выполнение - PullRequest
0 голосов
/ 26 ноября 2018

У меня есть файл Excel, который должен быть напечатан позже, однако я пытался создать макрос, который проверит, виден ли весь контент ячейки.Короче говоря, приведенный ниже код копирует значение ячейки во временную ячейку, и, если она может быть настроена на настройку только высоты строки, она делает это, если требуется изменить ширину столбца, помечая его цветом (.interior.colorindex).[код ниже].И это работает отлично, но в то же время в листе я использую условное форматирование для создания «таблицы», для лучшей видимости данных (я не могу использовать стандартную таблицу по разным причинам).Как вы, возможно, знаете, стандартное условное форматирование не может быть перезаписано, поэтому я создал UDF и использовал его в формуле условного форматирования.

Function TestColor(MyRange As Range) As Boolean
Application.Volatile
If Range(MyRange.Address).Interior.Pattern = xlNone Then
    TestColor = True
Else
    TestColor = False
End If
End Function

Кроме того, он работал как положено, но Worksheet_change перестал работать в то же время.Отдельно оба кода работают отлично, вместе работает только UDF в условном форматировании.Есть ли у вас какие-либо идеи, как изменить это, чтобы начать работать или как-то обойти для аналогичного случая?

РЕДАКТИРОВАТЬ: Если я изменяю значение вне диапазона условного форматирования, процедура «Подходит» работает правильно, поэтомупохоже, что ссылка UDF активно блокирует «Подходит» для продолжения.

Private Sub Worksheet_Change(ByVal Target As Range)
 call Fits(Target)
End sub

Sub Fits(ByVal Range As Range)
Dim cell As Range, tmp_cell As Range, da As Boolean, su As Boolean Wrap as string
'Stores current state and disables ScreenUpdating and DisplayAlerts
su = Application.ScreenUpdating: Application.ScreenUpdating = False
da = Application.DisplayAlerts: Application.DisplayAlerts = False
Application.EnableEvents = False
'Creates a new worksheet and uses first cell as temporary cell
Set tmp_cell = Worksheets("TemporaryTEST").Cells(1, 1)
Wrap= Range.Wraptext
'Enumerate all cells in Range
For Each cell In Range.Cells
    'Copy cell to temporary cell
    cell.Copy tmp_cell
    'Copy cell value to temporary cell, if formula was used
    If cell.HasFormula Then tmp_cell.Value = cell.Value
    'Checking depends on WrapText
    Select Case Wrap
        Case "True", "Null"
            'Ensure temporary cell column is equal to original
            tmp_cell.ColumnWidth = cell.ColumnWidth
            tmp_cell.EntireRow.AutoFit 'Force fitting
            If tmp_cell.RowHeight > cell.RowHeight Then 'Cell doesn't fit!
                If tmp_cell.RowHeight = 409.5 Then
                    tmp_cell.EntireColumn.AutoFit 'Force fitting
                    If tmp_cell.ColumnWidth > cell.ColumnWidth Then 'Cell doesn't fit!
                        cell.Interior.ColorIndex = 20
                        Exit For
                    End If
                End If
                'row extension needed
                cell.RowHeight = tmp_cell.RowHeight
                Exit For 'Exit For loop (at least one cell doesn't fit)
            End If
        Case "False"
            tmp_cell.EntireColumn.AutoFit 'Force fitting
            If tmp_cell.ColumnWidth > cell.ColumnWidth Then
                cell.Interior.ColorIndex = 20
                Exit For 'Exit For loop (at least one cell doesn't fit)
            End If
    End Select
Next
tmp_cell.Value = ""
tmp_cell.Columns.UseStandardWidth = True
tmp_cell.Rows.UseStandardHeight = True
'Restore ScreenUpdating and DisplayAlerts state
Application.DisplayAlerts = da
Application.ScreenUpdating = su
Application.EnableEvents = True
Application.CalculateFull
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...