VBA 根据所选的下拉值更改形状颜色

问题描述 投票:0回答:1

我正在尝试更改当前均为红色的 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)

excel vba
1个回答
0
投票

这样的东西应该可以工作(将其放入“仪表板”的代码模块中):

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
© www.soinside.com 2019 - 2024. All rights reserved.