Change colour of multiple shapes in a Chart???????? HELP!
Hi all,
Can anybody please help... i have the code below that changes the Shape (Freeform 13) on a Chart2 tab, in Sheet1 in cell a9, is a value that determines the colour of the shape.. and this works fine... the question is, how do i modify this code so that i can add other shapes to the Chart2 i.e. Freeform 11, 12 etc.. with the colour determined from cells A10, A11 in sheet1... ?? i am trying to get a map of the uk - by region - to change colour depending the status (number value) in a cell.... any help.. REALLY appreciated... Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Long Dim myShape As Shape If Target.Cells.Count 1 Then Exit Sub If Intersect(Target, Me.Range("a9")) Is Nothing Then Exit Sub ' chart object not worksheet Set myShape = Charts("Chart2").Shapes("Freeform 13") ' non textual comparison Select Case Target.Value Case Is 1: myColor = 53 Case Is < 1: myColor = 33 Case Is = 1: myColor = 25 Case Else myColor = 0 End Select If myColor = 0 Then myShape.Fill.Visible = False Else With myShape.Fill .Visible = True .ForeColor.SchemeColor = myColor End With End If End Sub cheers P |
Change colour of multiple shapes in a Chart???????? HELP!
Do you use the same rules to determine the colors?
If yes, maybe you can modify this untested (but compiled ok!) code: Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Long Dim myShapeNames As Variant Dim myAddr As Variant Dim iCtr As Long Dim myShape As Shape If Target.Cells.Count 1 Then Exit Sub myAddr = Array("a9", "b13", "C22") myShapeNames = Array("Freeform 13", "Freeform 14", "Freeform 15") If UBound(myAddr) < UBound(myShapeNames) Then MsgBox "Design error #1" Exit Sub End If For iCtr = LBound(myAddr) To UBound(myAddr) If Not Intersect(Target, Me.Range(myAddr(iCtr))) Is Nothing Then Set myShape = Nothing On Error Resume Next Set myShape = Charts("Chart2").Shapes(myShapeNames(iCtr)) On Error GoTo 0 If myShape Is Nothing Then MsgBox "Design error #2" Exit Sub End If Select Case Target.Value Case Is 1: myColor = 53 Case Is < 1: myColor = 33 Case Is = 1: myColor = 25 Case Else myColor = 0 End Select If myColor = 0 Then myShape.Fill.Visible = False Else With myShape.Fill .Visible = True .ForeColor.SchemeColor = myColor End With End If End If Next iCtr End Sub wrote: Hi all, Can anybody please help... i have the code below that changes the Shape (Freeform 13) on a Chart2 tab, in Sheet1 in cell a9, is a value that determines the colour of the shape.. and this works fine... the question is, how do i modify this code so that i can add other shapes to the Chart2 i.e. Freeform 11, 12 etc.. with the colour determined from cells A10, A11 in sheet1... ?? i am trying to get a map of the uk - by region - to change colour depending the status (number value) in a cell.... any help.. REALLY appreciated... Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Long Dim myShape As Shape If Target.Cells.Count 1 Then Exit Sub If Intersect(Target, Me.Range("a9")) Is Nothing Then Exit Sub ' chart object not worksheet Set myShape = Charts("Chart2").Shapes("Freeform 13") ' non textual comparison Select Case Target.Value Case Is 1: myColor = 53 Case Is < 1: myColor = 33 Case Is = 1: myColor = 25 Case Else myColor = 0 End Select If myColor = 0 Then myShape.Fill.Visible = False Else With myShape.Fill .Visible = True .ForeColor.SchemeColor = myColor End With End If End Sub cheers P -- Dave Peterson |
Change colour of multiple shapes in a Chart???????? HELP!
Since you're checking to make sure only one cell is changed, you could leave
that "for each" loop after it finds the one cell that got changed: For iCtr = LBound(myAddr) To UBound(myAddr) If Not Intersect(Target, Me.Range(myAddr(iCtr))) Is Nothing Then Set myShape = Nothing On Error Resume Next Set myShape = Charts("Chart2").Shapes(myShapeNames(iCtr)) On Error GoTo 0 If myShape Is Nothing Then MsgBox "Design error #2" Exit Sub End If Select Case Target.Value Case Is 1: myColor = 53 Case Is < 1: myColor = 33 Case Is = 1: myColor = 25 Case Else myColor = 0 End Select If myColor = 0 Then myShape.Fill.Visible = False Else With myShape.Fill .Visible = True .ForeColor.SchemeColor = myColor End With End If Exit For '<-- added End If Next iCtr Dave Peterson wrote: Do you use the same rules to determine the colors? If yes, maybe you can modify this untested (but compiled ok!) code: Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Long Dim myShapeNames As Variant Dim myAddr As Variant Dim iCtr As Long Dim myShape As Shape If Target.Cells.Count 1 Then Exit Sub myAddr = Array("a9", "b13", "C22") myShapeNames = Array("Freeform 13", "Freeform 14", "Freeform 15") If UBound(myAddr) < UBound(myShapeNames) Then MsgBox "Design error #1" Exit Sub End If For iCtr = LBound(myAddr) To UBound(myAddr) If Not Intersect(Target, Me.Range(myAddr(iCtr))) Is Nothing Then Set myShape = Nothing On Error Resume Next Set myShape = Charts("Chart2").Shapes(myShapeNames(iCtr)) On Error GoTo 0 If myShape Is Nothing Then MsgBox "Design error #2" Exit Sub End If Select Case Target.Value Case Is 1: myColor = 53 Case Is < 1: myColor = 33 Case Is = 1: myColor = 25 Case Else myColor = 0 End Select If myColor = 0 Then myShape.Fill.Visible = False Else With myShape.Fill .Visible = True .ForeColor.SchemeColor = myColor End With End If End If Next iCtr End Sub wrote: Hi all, Can anybody please help... i have the code below that changes the Shape (Freeform 13) on a Chart2 tab, in Sheet1 in cell a9, is a value that determines the colour of the shape.. and this works fine... the question is, how do i modify this code so that i can add other shapes to the Chart2 i.e. Freeform 11, 12 etc.. with the colour determined from cells A10, A11 in sheet1... ?? i am trying to get a map of the uk - by region - to change colour depending the status (number value) in a cell.... any help.. REALLY appreciated... Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Long Dim myShape As Shape If Target.Cells.Count 1 Then Exit Sub If Intersect(Target, Me.Range("a9")) Is Nothing Then Exit Sub ' chart object not worksheet Set myShape = Charts("Chart2").Shapes("Freeform 13") ' non textual comparison Select Case Target.Value Case Is 1: myColor = 53 Case Is < 1: myColor = 33 Case Is = 1: myColor = 25 Case Else myColor = 0 End Select If myColor = 0 Then myShape.Fill.Visible = False Else With myShape.Fill .Visible = True .ForeColor.SchemeColor = myColor End With End If End Sub cheers P -- Dave Peterson -- Dave Peterson |
Change colour of multiple shapes in a Chart???????? HELP!
Dave,
you are officially my hero... worked like a dream.. many many many thanks.... have a fantastic new year... all the very best Paul |
Change colour of multiple shapes in a Chart???????? HELP!
|
All times are GMT +1. The time now is 07:50 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com