Suche Graph mit Daten und die Farbe wechseln von Balken auf Basis von Daten in Powerpoint

Question

Ich möchte ein Programm erstellen, das wird:

1. durch alle meine Dias und finden Folien, die Tabelle enthalten (s), diese Diagramme sind nicht mit einem Arbeitsblatt verknüpft
2. Diagramm muss Daten enthalten und wird von ChartType = xlColumnClustered oder ChartType(51) wie im Bild unten sein.
3. Wenn es hat Daten dann auf die Zahlen schauen und die Farben der einzelnen Balken ändern sich entsprechend der nachstehenden Grafik (> = 6.0 dann Rot, < = 8,0 dann Blau, 6,0 < = x> = 8.0 dann Purple)

Ich habe versucht, jeden Ausdruck im Locals-Fenster des Debuggers zu durchsuchen, um festzustellen, ob ich einen Unterschied zwischen einem Diagramm mit Daten und einem Diagramm ohne Daten finden konnte. Ich habe nichts gefunden. Ich bin mir nicht sicher, wie ich zwischen einer Folie mit Daten und einer ohne unterscheiden könnte.

Ich weiß auch nicht, wie ich auf die Daten im Diagramm zugreifen könnte, um die Farben anzuwenden.

Jede Hilfe würde geschätzt werden, wie man damit umgeht.

Vielen Dank!

Answer 1

i aufgezeichnet ein Makro in Excel von Bar wechselnden Farben und zwickte es

es tatsächlich eine Tabelle in Powerpoint, die Daten in jedes Diagramm in Powerpoint

Application.ActivePresentation.Slides(1).Shapes(1).Chart.ChartData.Workbook.activesheet 

-Feeds werden Sie müssen die Daten aus dem Arbeitsblatt lesen, um die Farben für die Bars zu entscheiden, denke ich

ist hier die Farbänderung r

Option Explicit 

Sub Macro1() 

    ' recorded in excel and modified 

    Dim chrt As Chart 
' Set chrt = ActiveSheet.ChartObjects("Chart 1").Chart     ' excel object 
    Set chrt = Application.ActivePresentation.Slides(1).Shapes(1).Chart 

    chrt.ClearToMatchStyle 
    chrt.ChartStyle = 203 
    chrt.ChartStyle = 340 
    chrt.ChartStyle = 333 
    chrt.ChartStyle = 399 

    chrt.ChartType = xlColumnClustered 

    Dim fsc As FullSeriesCollection 
    Set fsc = chrt.FullSeriesCollection 

    With fsc(1).Format.Fill 
     .Visible = msoTrue 
     .ForeColor.RGB = RGB(255, 192, 0) 
     .Transparency = 0.5 
     .Solid 
    End With 

    With fsc(1).Format.Line 
     .Visible = msoTrue 
     .ForeColor.RGB = RGB(255, 0, 0) 
     .Transparency = 0 
    End With 

    With fsc(2).Format.Fill 
     .Visible = msoTrue 
     .ForeColor.ObjectThemeColor = msoThemeColorAccent1 
     .ForeColor.TintAndShade = 0 
     .ForeColor.Brightness = -0.25 
     .Transparency = 0 
     .Solid 
    End With 

    With fsc(3).Format.Fill 
     .Visible = msoTrue 
     .ForeColor.RGB = RGB(146, 208, 80) 
     .Transparency = 0 
     .Solid 
    End With 

    With fsc(3).Format.Line 
     .Visible = msoTrue 
     .ForeColor.RGB = RGB(255, 0, 0) 
     .Transparency = 0 
    End With 

    With fsc(1).Points(1).Format.Fill 
     .Visible = msoTrue 
     .ForeColor.RGB = RGB(255, 0, 0) 
     .Transparency = 0.6299999952 
     .Solid 
    End With 

    With fsc(1).Points(1).Format.Line 
     .Visible = msoTrue 
     .ForeColor.RGB = RGB(0, 176, 80) 
     .Transparency = 0.0500000119 
     .Weight = 5 
     .Style = msoLineThickBetweenThin 
    End With 

End Sub 

Answer 2

This post half mir herauszufinden, was ich tun musste, gepaart mit einigen der Logik hier gepostet von @jsotola. Dies ist die PowerPoint-Version dieser beiden und tut genau das, was in der ursprünglichen Frage benötigt wurde.

Option Explicit 

Public Sub colorGraph() 

    Dim sld As Slide 
    Dim shpe As Shape 
    Dim pres As Object 
    Dim nPoint As Long 
    Dim iPoint As Long 
    Dim c As Chart 
    Dim s As Series 

    Set pres = ActivePresentation 

    For Each sld In pres.Slides 
     For Each shpe In sld.Shapes 

     Set s = shpe.Chart.SeriesCollection(1) 

     If Not shpe.HasChart Then GoTo nxtShpe 
     If Not shpe.Chart.ChartType = xlColumnClustered Then GoTo nxtShpe 
     If s.DataLabels.NumberFormat = "0%" Or s.DataLabels.NumberFormat = "0.0%" Or s.DataLabels.NumberFormat = "0.00%" Then GoTo nxtShpe 

      nPoint = s.Points.Count 

      For iPoint = 1 To nPoint 
       If s.Values(iPoint) >= 8 Then 
        s.Points(iPoint).Interior.Color = RGB(0, 255, 0) 
       ElseIf s.Values(iPoint) < 8 And s.Values(iPoint) >= 2 Then 
        s.Points(iPoint).Interior.Color = RGB(255, 0, 0) 
       ElseIf s.Values(iPoint) < 2 And s.Values(iPoint) > 0 Then 
        s.Points(iPoint).Interior.Color = RGB(0, 0, 255) 
       End If 
      Next iPoint    

nxtShpe: 

     Next shpe 
    Next sld 
End Sub