excel - 使用 UDF 块 Worksheet_change 执行条件格式化

Question

我有 excel 文件必须稍后打印，但是我试图创建宏 wchich 将检查整个单元格内容是否可见。长话短说，下面的代码是将单元格值复制到一个临时单元格，如果它可以安装只调整行高，它会这样做，如果需要更改列宽，它会用颜色标记它（.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

标签： excelvba