我正在尝试更改当前均为红色的 6 个圆段(显示为饼图)。我已经命名了每个分段形状。
根据在单元格 o5 中的工作表“仪表板”上选择的下拉值,我希望更改圆圈颜色。如果选择第一个选项“选项1”,我只想将1段变为黑色。如果选择第二个选项“选项2”,我想要2个片段变成黑色,依此类推。
我的圆段位于名为“项目跟踪器”的不同工作表上。
我没有收到任何错误,但也没有发生任何事情。 任何建议将不胜感激。
Private Sub Worksheet_change(ByVal Target As Range)
If Target.Address = "$O$5" And Target.Parent.Name = "Dashboard" Then
Select Case Target.Value
Case "Option 1"
Worksheets("Project tracker").Shapes("RT1").Fill.ForeColor.RGB = RGB(0, 0, 0)
Case "Option 2"
Worksheets("Project tracker").Shapes("RT1").Fill.ForeColor.RGB = RGB(0, 0, 0)
Worksheets("Project Tracker").Shapes("RT2").Fill.ForeColor.RGB = RGB(0, 0, 0)
Case "Option 3"
Worksheets("Project tracker").Shapes("RT1").Fill.ForeColor.RGB = RGB(0, 0, 0)
Worksheets("Project tracker").Shapes("RT2").Fill.ForeColor.RGB = RGB(0, 0, 0)
Worksheets("Project tracker").Shapes("RT3").Fill.ForeColor.RGB = RGB(0, 0, 0)
End Select
End If
End Sub
(我也尝试过 'If Target.Address = Worksheets("Dashboard").Range("$O$5") then)
这样的东西应该可以工作(将其放入“仪表板”的代码模块中):
Private Sub Worksheet_change(ByVal Target As Range)
Dim i As Long, v, n As Long
If Target.Address <> "$O$5" Then Exit Sub 'cell of interest?
v = Target.Value
'get selected option, or if cell is empty then set n=0 to set all back to red
n = IIf(Len(v) > 0, CLng(Right(v, 1)), 0)
With ThisWorkbook.Worksheets("Project tracker")
For i = 1 To 6
'choose color based on value of n
.Shapes("RT" & i).Fill.ForeColor.RGB = IIf(i <= n, vbBlack, vbRed)
Next i
End With
End Sub