Question

我有一个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一起工作。您是否知道如何对其进行修改以开始工作或在类似情况下可以解决？

编辑： 如果我在条件格式范围之外更改值，则“ Fits”过程可以正常工作，因此看起来UDF参考正在积极阻止“ Fits”继续进行。

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

使用UDF块执行Worksheet_change的条件格式

0 个答案: