Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change colour of multiple shapes in a Chart???????? HELP!
|
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How do i change the size of multiple shapes at the same time? | Excel Discussion (Misc queries) | |||
Gantt chart colour change | Charts and Charting in Excel | |||
Trying to loop through all shapes on multiple worksheets and change color | Excel Programming | |||
Change permanantly default chart settings like colour, font.. | Charts and Charting in Excel | |||
How do I change the inverse colour in an Excel chart? | Charts and Charting in Excel |