Diagramme automatisch formatieren

[Alexandros]

Hallo liebe Gemeinde.

Ich habe ein Problem. Ich habe ein Makro aus dem Internet gefunden, dass mir die Diagramme anhand bedingter Formatierungen in der jeweiligen Farbe formatiert. Problem bei der Sache ist, dass er das für alle Diagramme macht, die in dem Arbeitsblatt sind. Da ich leider ein Laie bin was VBA angeht bräuchte ich eure Hilfe. Wie muss ich den Code so ändern, dass sich der Code nur auf einzelne Diagramme bezieht und nicht auf alle in dem Arbeitsblatt?

Danke schon mal, hoffentlich komme ich endlich zu einer Lösung. :) 

So sieht der Code jetzt aus:

Sub cellcolorstochart()

Dim ochart As ChartObject
Dim myseries As Series
Dim formulasplit As Variant
Dim sourerange As Range
Dim sourcerangecolor As Long
Dim numberofdatapoints As Long
Dim ipoint As Long


'Loop through all charts in the active sheet

For Each ochart In ActiveSheet.ChartObjects

    'loop through all series in the target chart
    For Each myseries In ochart.Chart.SeriesCollection
    numberofdatapoints = myseries.Points.Count
    
    For ipoint = 1 To numberofdatapoints
    
            'get source data range for the target series
            formulasplit = Split(myseries.Formula, ",")
            
            'capture the first cell in the source range then trap the color
            Set SourceRange = Range(formulasplit(2)).Item(ipoint)
            'sourcerangecolor = SourceRange.Interior.Color
            
            'if coloring without conditional formatting
            'Set SourceRange = Range(formulasplit(2)).Item(ipoint)
            sourcerangecolor = SourceRange.DisplayFormat.Interior.Color
            
    On Error Resume Next

        'Coloring for Excel 2003
        'myseries.Interior.Color = sourcerangecolor
        'myseries.Border.Color = sourcerangecolor
        'myseries.MarkerBackgroundColorIndex = sourcerangecolor
        'myseries.MarkerForegroundColorIndex = sourcerangecolor
        
        'Coloring for Excel 2007 and 2010
        myseries.Points(ipoint).MarkerBackgroundColor = sourcerangecolor
        myseries.Points(ipoint).MarkerForegroundColor = sourcerangecolor
        'myseries.Points(ipoint).Format.Line.ForeColor.RGB = sourcerangecolor
        'myseries.Points(ipoint).Format.Line.BackColor.RGB = sourcerangecolor
        myseries.Points(ipoint).Format.Fill.ForeColor.RGB = sourcerangecolor
        'myseries.Points(ipoint).Format.Line.ForeColor.RGB = sourcerangecolor
    
Next
Next myseries
Next ochart


End Sub

[BoskoBiati]

Hallo,

hiermit:

Code:

For Each ochart In ActiveSheet.ChartObjects

wird eine Schleife über alle Diagramme gestartet. das mußt Du ändern!

[Alexandros]

Das For Each ochart .... müsste ich dann ersetzen durch die jeweiligen Diagrammnamen, die ich formatieren möchte, habe ich das richtig verstanden?

[BoskoBiati]

Hallo,

ich denka ja!

[Alexandros]

Habe es versucht mit einem "Charts("Chart_Name").activate" zu ersetzen, aber VBA sendet immer einen Fehler und ich weiß nicht woran das liegen könnte zum einen habe ich auch recht wenig Erfahrung mit VBA.

Ihm passt das mit dem ochart im weiteren Verlauf des Codes nicht.

[Käpt'n Blaubär]

Hallo,

... aber VBA sendet immer einen Fehler und ich weiß nicht woran das liegen könnte 

wer soll denn bei einer solchen Aussage helfen?
Was sagt die Fehlermeldung???  ... meine Kristallkugel streikt nämlich gerade.

Allerdings, eine trübe Ahnung hätte ich schon. Was hast Du an dem Makro geändert?
Nur die Zeile For Each ochart In ActiveSheet.ChartObjects ???

[Alexandros]

Hallo,


wer soll denn bei einer solchen Aussage helfen?
Was sagt die Fehlermeldung???  ... meine Kristallkugel streikt nämlich gerade.

Allerdings, eine trübe Ahnung hätte ich schon. Was hast Du an dem Makro geändert?
Nur die Zeile For Each ochart In ActiveSheet.ChartObjects ???

Entschuldige... Da hast du Recht. Wobei eine Kristallkugel durchaus mal hilfreich sein könnte!

Bei der einmaligen Änderung der Zeile "For Each oChart in Activesheet.chartobjects" zu "Worksheets("Name Blatt").ChartObjects("Name Diagramm").Select"

In der vorletzten Zeile entferne ich noch zusätzlich das "Next for oChart" und bekomme dann folgende Fehlermeldung.

"Run-Time Error 91:

Object variable or with block variable not set"

[BoskoBiati]

Hallo,

Du mußt natürlich dem ochart ein Diagramm zuweisen!

[Kuwer]

Hallo Alexandros,

Du mußt natürlich dem ochart ein Diagramm zuweisen!

um es nicht so spannend zu machen:

Ersetze

For Each ochart In ActiveSheet.ChartObjects

durch

Set ochart = Worksheets("Name Blatt").ChartObjects("Name Diagramm")

Gruß Uwe