excel - VBA - 在单元格刷新后，我无法刷新链接到公式的形状条件格式

Question

我需要你的帮助。 上下文：我有一个 VBA 可以将颜色（绿色、橙色、红色）更改为与 % 值相关的几个形状。这些值将根据列表框而改变。但是，如果 % 发生变化，则格式不遵循。

宏如下所示 - 您知道如何“强制”刷新以使形状格式跟随任何单元格更改吗？以下尝试强制失败。

Private Sub Worksheet_Change(ByVal Target As Range)

    EnableFormatConditionsCalculation = True    
    If Target.Address = "$K$16" Then 
    With Sheets("Resources").Shapes("Oval 1")    
    If Sheets("Resources").Cells(16, 11).Value < 0.95 Then 
    .Fill.ForeColor.RGB = RGB(255, 0, 0)    
    Else If 
    Sheets("Resources").Cells(16, 11).Value > 0.99 Then 
    .Fill.ForeColor.RGB = RGB(0, 255, 0)    
    Else 
    .Fill.ForeColor.RGB = RGB(255, 153, 0)    
    End If    
    End If    
    End With    
    ElseIf Target.Address = "$L$16" Then 
    With Sheets("Resources").Shapes("Oval 2")    
    If Sheets("Resources").Cells(16, 12).Value < 0.95    Then 
    .Fill.ForeColor.RGB = RGB(255, 0, 0)    
    Else If Sheets("Resources").Cells(16, 12).Value > 0.99    Then 
    .Fill.ForeColor.RGB = RGB(0, 255, 0)    
    Else 
    .Fill.ForeColor.RGB = RGB(255, 153, 0)     
    End If    
    End If    
    End With 
    Range("K16:W16").Calculate    
    End If    

End Sub

Answer 1

试试这个：

Private Sub Worksheet_Calculate()

    CheckFormat Me.Range("K16"), "Oval 1"
    CheckFormat Me.Range("L16"), "Oval 2"

End Sub

Sub CheckFormat(valueRange As Range, shapeName As String)
    Dim v, clr As Long
    v = valueRange.Value 

    If Len(v) = 0 Then
        clr = RGB(255, 255, 255) '<< EDIT: use white if no value
    Else
        If v < 0.95 Then
            clr = RGB(255, 0, 0)
        ElseIf v > 0.99 Then
            clr = RGB(0, 255, 0)
        Else
            clr = RGB(255, 153, 0)
        End If
    End If
    Me.Shapes(shapeName).Fill.ForeColor.RGB = clr
End Sub

Answer 2

如果用户手动更改任何单元格，

Worksheet_Change 将启动。如果您的任何公式（如 RANDBETWEEN）会带来新的价值，则不会触发它。

您可能有兴趣将您的例程重铸为 VOLATILE 类型的 VBA 公式。单击链接以遵循一些说明。长话短说 - 您可以将一个特殊命令放入您的用户定义函数中，这样每次您的工作簿中发生更改时它都会运行。您可以将该公式放入 $K$16 单元格中。

希望对您有所帮助。