基于单元格值的条件格式形状填充答案

【问题标题】：Conditional Format Shape Fill Based on Cell Value基于单元格值的条件格式形状填充
【发布时间】：2020-11-23 00:23:03
【问题描述】：

我不想问这个问题，因为我不知道从哪里开始，所以我现在没有任何代码。我看到了一些关于这个主题的东西，但找不到我要找的东西。

表格为 5 列（ID + 螺栓数）x 13 行 (ID)

我有四个形状 (Oval4-Oval7)，我想根据四个相应的单元格从红色/橙色/绿色更改（这些单元格值的选项是：空的、安装的、扭矩的）。

形状还会根据第一列中选择的 ID (1-13) 改变颜色。

因此，如果您将光标放在 ID 2 单元格上，形状会根据同一行中第 2-5 列中的值改变颜色。

这是否过于复杂？

我会继续自己努力。只是想我会从这里开始。

感谢您的宝贵时间。

以下代码有效，但如何将其应用于整个表格？

 Private Sub Worksheet_Change(ByVal Target As Range)
 If Range("d12") = "Empty" Then
 ActiveSheet.Shapes.Range(Array("Shape1")).Select
 Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
 Else
 If Range("d12") = "Installed" Then
 ActiveSheet.Shapes.Range(Array("Shape1")).Select
 Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 155, 0)
 Else
 If Range("d12") = "Torqued" Then
 ActiveSheet.Shapes.Range(Array("Shape1")).Select
 Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 255, 0)
 End If
 End If
 End If
 End Sub

【问题讨论】：

有一个Worksheet_SelectionChange 事件可用于运行更新。
屏幕截图可能有助于可视化您想要实现的目标。我很难在脑海中看到这一点。
还有很多例子，比如exceldashboardschool.com/conditional-formatting-shapes
@TimWilliams 你知道如何让代码为数组工作吗？

标签： excel vba colors conditional-formatting shapes

【解决方案1】：

在工作表代码模块中：

Private Sub Worksheet_Change(ByVal Target As Range)
    ResolveSelection Target.Cells(1)
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ResolveSelection Target.Cells(1)
End Sub

'Is the selected/changed cell in one of the two tables?
'  If Yes get the full row for that cell and pass to SetRow
Sub ResolveSelection(Target As Range)
    Dim r, rng As Range
    For Each r In Array("B3:G14", "J3:O14") 'my 2 test tables
        Set rng = Application.Intersect(Target, Me.Range(r))
        If Not rng Is Nothing Then
            'get the whole row of the table
            Set rng = Application.Intersect(Target.EntireRow, Me.Range(r))
            SetRow rng
            Exit Sub
        End If
    Next r
End Sub

'set the coloring based on the row 'rw'
Sub SetRow(rw As Range)
    Dim i As Long, shp As Shape
    Debug.Print rw.Address
    For i = 1 To 4
        Set shp = rw.Parent.Shapes("Shape" & i)
        shp.Fill.ForeColor.RGB = GetColor(rw.Cells(2 + i).Value)
    Next i
End Sub

'get the color for a given state
Function GetColor(v As String) As Long
    Select Case v & ""
        Case "Empty", "": GetColor = vbRed
        Case "Installed": GetColor = RGB(255, 155, 0)
        Case "Torqued": GetColor = vbGreen
        Case Else: GetColor = vbWhite
    End Select
End Function

【讨论】：