AW: Ideen oder Lösungsvorschläge :)
27.07.2018 13:03:03
Rudi
Hallo,
als Anregung:
Sub aaa()
Dim ws As Worksheet
Dim co As ChartObject
Dim ch As Chart, p As Point
Dim i As Integer, lngColor As Long
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = "Diagramm"
Set co = ThisWorkbook.Worksheets("Diagramm").ChartObjects.Add(175, 10, 750, 750)
Set ch = co.Chart
With ch
.SetSourceData Worksheets("Risikoindikator").Range("A1:B63")
.ChartType = xlBarClustered
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Prozesse"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Risikoindikator"
.SetElement (msoElementDataLabelOutSideEnd)
.SetElement (msoElementLegendNone)
End With
With Worksheets("Risikoindikator")
For i = 2 To 63
Set p = ch.SeriesCollection(1).Points(i - 1)
Select Case .Cells(i, 3)
Case 100 To 149: lngColor = RGB(100, 200, 230)
Case 150: lngColor = RGB(150, 200, 200)
Case 200 To 250: lngColor = RGB(130, 198, 50)
Case Else: lngColor = RGB(200, 200, 200)
End Select
p.Interior.Color = lngColor
Next i
End With
End Sub
Gruß
Rudi