Graf farve på søjler alt efter værdi (vba)
Kære EksperterJeg har en graf hvor dataen via en række formler sorterer automatisk i størrelsesorden. Nu ønsker jeg at sætte farve (bare rød/gul/grøn) på søjlerne alt efter deres værdi.
Da jeg i forvejen har en anderledes struktur på dataen kan jeg ikke bruge denne løsning:
http://www.eksperten.dk/spm/259833
Jeg har derfor arbejdet med vba, men det driller. Kraftigt inspireret af Googling har jeg fået skrevet denne:
Sub Color_BarChart_Categories()
' Color Each Bar (Series) in a Bar Chart
' based on its percent value.
' Note: Instead of Series you can base on Categories.
'--
Dim oChart As Excel.Chart
Dim oChartObject As Excel.ChartObject
Dim oPoint As Excel.Point
Dim sngPercente As Single
'--
' Reference first chart on worksheet 'Sheet1'
Set oChartObject = ThisWorkbook.ActiveSheet.ChartObjects("Chart 11")
oChartObject.Activate
Set oChart = oChartObject.Chart
'--
' Loop Series and color based on its percent values
For Each oPoint In oChart.SeriesCollection(1).Points
With oPoint
.Format.Fill.Visible = msoTrue
.Format.Fill.Solid
'--
Select Case sngPercente
Case Is < 0.8: .Interior.Color = vbRed
Case Is < 0.9: .Interior.Color = vbYellow
Case Else: .Interior.Color = vbGreen
End Select
End With
Next oPoint
' Release object variables
Set oChartObject = Nothing
Set oChart = Nothing
End Sub
Desværre farver den alle søjler røde - hvilket får mig til at tro det er noget med min % løsning som ikke fungerer.
Samtidig er det en smule indviklet for en rookie som jeg. Det burde da være muligt at lave en simpel VBA a la dette:
Sub Color_BarChart_values()
' Color Each Bar (Series) in a Bar Chart
' based on its value.
Dim i As Integer
Dim sngValue As Single
' Reference first chart on worksheet 'Sheet1'
ThisWorkbook.ActiveSheet.ChartObjects("Chart 11").Activate
For i = 1 To 9
sngValue = Selection.SeriesCollection(1).Points(i)
With sngValue
.Format.Fill.Visible = msoTrue
.Format.Fill.Solid
Select Case sngValue
Case Is < 0.8: .Interior.Color = vbRed
Case Is < 0.9: .Interior.Color = vbYellow
Case Else: .Interior.Color = vbGreen
End Select
End With
Next i
End Sub