У меня есть файл 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