[英]Conditional Format Shape Fill Based on Cell Value
I hate to ask this question because I don't know where to start so I don't have any code right now.我不想问这个问题,因为我不知道从哪里开始,所以我现在没有任何代码。 I've seen some stuff about the topic but can't find what I'm looking for.
我看过一些关于这个主题的东西,但找不到我要找的东西。
Table is 5 column (ID + Bolt count) x 13 rows (ID)表格是 5 列(ID + 螺栓数)x 13 行(ID)
I have four shapes (Oval4-Oval7) that I would like to change from red/orange/green based on four corresponding cells (options for those cell values are: empty, installed, torqued).我有四种形状 (Oval4-Oval7),我想根据四个相应的单元格从红色/橙色/绿色更改(这些单元格值的选项是:空、已安装、已扭曲)。
The shapes would also change color based on a chosen ID (1-13) in the first column.这些形状还会根据第一列中选择的 ID (1-13) 更改颜色。
So if you put your cursor on ID 2 cell, the shapes would change color based on the values in columns 2-5 from the same row.因此,如果您将 cursor 放在 ID 2 单元格上,形状将根据同一行第 2-5 列中的值更改颜色。
Is this too overly complex?这太复杂了吗?
I will continue to work on it myself.我会自己继续努力。 Just figured I would start here.
只是想我会从这里开始。
Thanks for your time.谢谢你的时间。
Below code works but how do I apply it to the entire table?下面的代码有效,但我如何将它应用于整个表格?
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
In the sheet code module:在工作表代码模块中:
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.