HERBERS Excel-Forum - das Archiv

Thema: Formatierung anderer Diagramme

Formatierung anderer Diagramme
Jonas

Hallo Leute,
ich habe am Freitag ein Makro von Beverly bekommen. Das funktioniert hervoragend. Es formatiert die Diagramme der Arbeitsmappe nach dem ersten Diagramm.
Kann mir jemand sagen, was geändert werden muss damit sich gleichzeitig die Diagramme in den anderen Arbeitsmappen mitändern oder ist das so nicht möglich?


Sub dia_anpassen()
Dim chDiagramm1 As Chart
Dim chDiagramm2 As ChartObject
Dim inReihe As Integer
Set chDiagramm1 = ActiveSheet.ChartObjects(1).Chart
For Each chDiagramm2 In ActiveSheet.ChartObjects
With chDiagramm2.Chart
For inReihe = 1 To .SeriesCollection.Count
With .SeriesCollection(inReihe)
.Border.ColorIndex = chDiagramm1.SeriesCollection(inReihe).Border. _
ColorIndex
If .Border.LineStyle = xlAutomatic Then
.Border.Weight = chDiagramm1.SeriesCollection(inReihe).Border.Weight
End If
.Border.LineStyle = chDiagramm1.SeriesCollection(inReihe).Border.LineStyle
.MarkerBackgroundColorIndex = chDiagramm1.SeriesCollection(inReihe). _
MarkerBackgroundColorIndex
.MarkerForegroundColorIndex = chDiagramm1.SeriesCollection(inReihe). _
MarkerForegroundColorIndex
.MarkerStyle = chDiagramm1.SeriesCollection(inReihe).MarkerStyle
.MarkerSize = chDiagramm1.SeriesCollection(inReihe).MarkerSize
End With
Next inReihe
End With
Next chDiagramm2
Set chDiagramm1 = Nothing
End Sub


Vielleicht ist Beverly ja schon online und kann mir gleich nochmal helfen.
Vielen vielen Dank im Voraus.
Gruß
Jonas

AW: Formatierung anderer Diagramme
Beverly

Hi Jonas,
wärst du im anderen Thread geblieben hätte ich deine Frage schon viel eher gelesen, weil ich benachrichtigt worden wäre.
Es werden alle Diagramme aller Tabellenblätter aller geöffneten Arbeitsmappen an das Format des 1. Diagramms der aktiven Tabelle angepasst:


Sub dia_anpassen()
Dim chDiagramm1 As Chart
Dim chDiagramm2 As ChartObject
Dim inReihe As Integer
Dim wbMappe As Workbook
Dim wsTabelle As Worksheet
Set chDiagramm1 = ActiveSheet.ChartObjects(1).Chart
For Each wbMappe In Workbooks
For Each wsTabelle In wbMappe.Worksheets
If wsTabelle.ChartObjects.Count > 0 Then
For Each chDiagramm2 In wsTabelle.ChartObjects
With chDiagramm2.Chart
For inReihe = 1 To .SeriesCollection.Count
With .SeriesCollection(inReihe)
.Border.ColorIndex = chDiagramm1.SeriesCollection(inReihe). _
Border.ColorIndex
If .Border.LineStyle = xlAutomatic Then
.Border.Weight = chDiagramm1.SeriesCollection(inReihe). _
Border.Weight
End If
.Border.LineStyle = chDiagramm1.SeriesCollection(inReihe). _
Border.LineStyle
.MarkerBackgroundColorIndex = chDiagramm1.SeriesCollection( _
inReihe).MarkerBackgroundColorIndex
.MarkerForegroundColorIndex = chDiagramm1.SeriesCollection( _
inReihe).MarkerForegroundColorIndex
chDiagramm2.Chart.SeriesCollection(inReihe).MarkerStyle =  _
chDiagramm1.SeriesCollection(inReihe).MarkerStyle
.MarkerSize = chDiagramm1.SeriesCollection(inReihe).MarkerSize
End With
Next inReihe
End With
Next chDiagramm2
End If
Next wsTabelle
Next wbMappe
Set chDiagramm1 = Nothing
End Sub