简体   繁体   中英

Update color of shape based on cell with calculated value

Scenario: I have a dashboard with tiles for things such as "Overdue Tasks". I have a shape called tileOverdueTasks . On top of it I have a wordart with a value of =Z11 . Cell Z11 is calculated based on values in a separate sheet ( Sheet5 (Tasks) ). If Tasks.Z11 = 0 I want tileOverdueTasks to be green. If it's anything else, I want it to be red.

I found the code below but it does not seem to trigger, I'm assuming due to the fact that cell Z11 is not being changed manually and thus neither is the ActiveWorkbook . So, how can I modify this to work given the scenario above?

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("Z11")) Is Nothing Then
        If IsNumeric(Target.Value) Then
            If Target.Value > 0 Then
                ActiveSheet.Shapes("tileOverdueTasks").Fill.BackColor.RGB = vbRed
            Else
                ActiveSheet.Shapes("tileOverdueTasks").Fill.BackColor.RGB = vbGreen
            End If
        End If
    End If
End Sub

UPDATE: I have changed the event to Worksheet.calculate as suggested by @Scott Craner. Now the event fires and it even enters the proper condition, however the color is not changing.

There were two problems.

1) As pointed out by Scott Craner , I needed to use the Worksheet_Calculate event.

2) Due to the style of the shape, Fill.BackColor was not working. I changed it to Fill.ForeColor and now it works.

Here is the working code:

Private Sub Worksheet_Calculate()
    If Sheets("Dashboard").Range("Z11").Value > 0 Then
        Sheets("Dashboard").Shapes("tileOverdueTasks").Fill.ForeColor.RGB = RGB(185, 0, 0)
    Else
        Sheets("Dashboard").Shapes("tileOverdueTasks").Fill.ForeColor.RGB = RGB(0, 185, 0)
    End If
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM