VBA技术问题：根据下拉框值修改饼图分段颜色无响应

核心问题分析 #

你的代码无报错但无效果，大概率是以下细节问题导致：

• 事件代码放置位置错误：Worksheet_Change事件必须绑定到Dashboard工作表的代码模块中，不能放在标准模块或其他工作表模块里。
• 工作表名称大小写不统一：代码中混用了Project tracker和Project Tracker，VBA对工作表名称大小写敏感，必须和实际工作表的名称完全一致。
• 形状名称不匹配：确认RT1/RT2/RT3等名称与饼图分段的实际名称（在Excel的名称框中查看）完全一致，包括大小写和拼写。
• 事件触发被禁用：可能之前的代码意外关闭了事件触发，导致Worksheet_Change无法执行。

修复后的代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 确保事件触发正常
    Application.EnableEvents = True
    
    ' 限定触发范围为Dashboard的O5单元格
    If Target.Address = "$O$5" Then
        Dim ws As Worksheet
        Set ws = ThisWorkbook.Worksheets("Project Tracker") ' 统一工作表名称
        
        ' 先重置所有6个分段为红色（原颜色）
        ws.Shapes("RT1").Fill.ForeColor.RGB = RGB(255, 0, 0)
        ws.Shapes("RT2").Fill.ForeColor.RGB = RGB(255, 0, 0)
        ws.Shapes("RT3").Fill.ForeColor.RGB = RGB(255, 0, 0)
        ws.Shapes("RT4").Fill.ForeColor.RGB = RGB(255, 0, 0)
        ws.Shapes("RT5").Fill.ForeColor.RGB = RGB(255, 0, 0)
        ws.Shapes("RT6").Fill.ForeColor.RGB = RGB(255, 0, 0)
        
        ' 根据下拉选项设置对应数量的黑色分段
        Select Case Target.Value
            Case "Option 1"
                ws.Shapes("RT1").Fill.ForeColor.RGB = RGB(0, 0, 0)
            Case "Option 2"
                ws.Shapes("RT1").Fill.ForeColor.RGB = RGB(0, 0, 0)
                ws.Shapes("RT2").Fill.ForeColor.RGB = RGB(0, 0, 0)
            Case "Option 3"
                ws.Shapes("RT1").Fill.ForeColor.RGB = RGB(0, 0, 0)
                ws.Shapes("RT2").Fill.ForeColor.RGB = RGB(0, 0, 0)
                ws.Shapes("RT3").Fill.ForeColor.RGB = RGB(0, 0, 0)
            Case "Option 4"
                ws.Shapes("RT1").Fill.ForeColor.RGB = RGB(0, 0, 0)
                ws.Shapes("RT2").Fill.ForeColor.RGB = RGB(0, 0, 0)
                ws.Shapes("RT3").Fill.ForeColor.RGB = RGB(0, 0, 0)
                ws.Shapes("RT4").Fill.ForeColor.RGB = RGB(0, 0, 0)
            Case "Option 5"
                ws.Shapes("RT1").Fill.ForeColor.RGB = RGB(0, 0, 0)
                ws.Shapes("RT2").Fill.ForeColor.RGB = RGB(0, 0, 0)
                ws.Shapes("RT3").Fill.ForeColor.RGB = RGB(0, 0, 0)
                ws.Shapes("RT4").Fill.ForeColor.RGB = RGB(0, 0, 0)
                ws.Shapes("RT5").Fill.ForeColor.RGB = RGB(0, 0, 0)
            Case "Option 6"
                ws.Shapes("RT1").Fill.ForeColor.RGB = RGB(0, 0, 0)
                ws.Shapes("RT2").Fill.ForeColor.RGB = RGB(0, 0, 0)
                ws.Shapes("RT3").Fill.ForeColor.RGB = RGB(0, 0, 0)
                ws.Shapes("RT4").Fill.ForeColor.RGB = RGB(0, 0, 0)
                ws.Shapes("RT5").Fill.ForeColor.RGB = RGB(0, 0, 0)
                ws.Shapes("RT6").Fill.ForeColor.RGB = RGB(0, 0, 0)
        End Select
    End If
End Sub

操作步骤 #

1. 打开Excel，按Alt+F11进入VBE编辑器。
2. 在左侧工程窗口中找到Dashboard工作表，双击打开其代码模块。
3. 将上述代码粘贴到该模块中，替换原有代码。
4. 确认Project Tracker是实际工作表的准确名称，RT1到RT6是饼图分段的正确形状名称。
5. 如果之前事件触发被禁用，在VBE的立即窗口（按Ctrl+G调出）输入Application.EnableEvents = True并回车执行。

内容的提问来源于stack exchange，提问作者user289040