(18.12.2017, 21:14)Fennek schrieb: Die Sub "alle_Blocks" wird gestartet und ruft dann die Erstellung, Plazierung und Anpassen der Daten auf.
mfg
Ich habe die Sub gerade gestartet. Leider klappt's nicht. Excel sagt, die Methode ChartObjects() für das Objekt Worksheet ist fehlgeschlagen. Damit kann ich leider nichts anfangen.
Nochmal zur Erinnerung: Ich habe Excel 2010. Ist dort evtl. diese Methode noch unbekannt?
mein Code ist in xl2016 entwickelt, es gibt vermutlich im Bereich Chart größere Unterschiede zwischen den Versionen als in anderer Bereichen. Aber ich habe keinerlei Überblick über die Unterschiede.
Reines Interesse eines Photoamateurs: Die unterschiedliche Qualität von Linsen in Abhängigkeit der Blende, war einer der "Learnings" und bei https://www.dxomark.com/Lenses hatte ich zu deiner Datei vergleichbare Messergebnisse gefunden. Das für Ur-Altglas (Agfa-Revenon ist aus den 80-er) ist interessant, wo soll das publiziert werden.
Zurück zu Excel:
Die Vorlage für den Code ist von Berverly, der (einzigen) Guru, die in dt Foren zu Chart Hilfestellungen gibt. Sie ist in vielen Foren aktiv, aber niemals hier. (Aber in http://www. ms- office- forum. net oder Herber, ihre Webseite: excel-inn.de)
Da ich schon mehr Zeit als vernünftig eingesetzt habe, stoppe ich meine Aktivitäten in diesem Thema.
mfg
Folgende(r) 1 Nutzer sagt Danke an Fennek für diesen Beitrag:1 Nutzer sagt Danke an Fennek für diesen Beitrag 28 • rob70
Xl kann relativ einfach Datenstrukturen anpassen, d.h. es könnte einfacher sein, die recht komplizierte Datenstruktur zuerst in ein für Charts einfaches Format zu bringen und dann die Charts neu aufzubauen.
Die Formatierungen des Charts können mit dem Rekorder aufgezeichet und auf alle neuen Charts übertragen werden.
Ein Ansatz:
Code:
Sub Neu_Aufbauen()
'ActiveCell auf Titel, z.B. A3
Dim Col As Range
Dim Cht As Chart
Dim Chtobj As ChartObject
Dim WS As Worksheet: Set WS = ActiveSheet
'blau: 141, 180, 226
'rot: 253, 99, 99
'grün: 196, 215, 155
Range("A3").Select ' <<<<<<<<<<< setzt >>>>>>>>>>>
r = ActiveCell.Row
Set Col = Range(Cells(r, 4), Cells(r, "R")).SpecialCells(xlCellTypeConstants).EntireColumn
For i = 1 To .SeriesCollection.Count
.FullSeriesCollection(i).Select
With Selection.Format.Line
.Visible = msoTrue
Select Case i
Case Is = 1
.ForeColor.RGB = RGB(141, 180, 226)
.DashStyle = msoLineSolid
Case Is = 2
.ForeColor.RGB = RGB(141, 180, 226)
.DashStyle = msoLineSysDash
Case Is = 3
.ForeColor.RGB = RGB(253, 99, 99)
.DashStyle = msoLineSolid
Case Is = 4
.ForeColor.RGB = RGB(253, 99, 99)
.DashStyle = msoLineSysDash
Case Is = 5
.ForeColor.RGB = RGB(196, 215, 155)
.DashStyle = msoLineSolid
Case Is = 6
.ForeColor.RGB = RGB(196, 215, 155)
.DashStyle = msoLineSysDash
End Select
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Visible = msoTrue
End With
Next i
End With
Set Chtobj = WS.ChartObjects(WS.ChartObjects.Count)
With Chtobj
.Top = Cells(r, "T").Top
.Left = Cells(r, "T").Left
End With
End Sub
Wenn die markierte Zeile gelöscht wird, kann man von Hand den Curser auf die erste Zelle des Datenblocks stellen und dann den Makro starten.
mfg
Folgende(r) 1 Nutzer sagt Danke an Fennek für diesen Beitrag:1 Nutzer sagt Danke an Fennek für diesen Beitrag 28 • rob70
Xl kann relativ einfach Datenstrukturen anpassen, d.h. es könnte einfacher sein, die recht komplizierte Datenstruktur zuerst in ein für Charts einfaches Format zu bringen und dann die Charts neu aufzubauen.
Die Formatierungen des Charts können mit dem Rekorder aufgezeichet und auf alle neuen Charts übertragen werden.
Ein Ansatz:
Wenn die markierte Zeile gelöscht wird, kann man von Hand den Curser auf die erste Zelle des Datenblocks stellen und dann den Makro starten.
mfg
Hallo Fennek,
es ist eine gute Idee, die Diagramme neu aufzubauen.
Leider funktioniert es noch nicht, weil meiner Excel-Version die Methode bzw. das Objekt ".fullSeriesCollection..." unbekannt ist.
Ich vermute, dass Dir hier auch keine ältere Methode einfällt, mit der das Ganze noch funktioniert? Wenn Du (verständlicherweise) aufgibst, weil ich eben nicht die passende Excel-Version habe, werde ich Deinen Tipp beherzigen und es in einem anderen der vorgeschlagenen Foren noch einmal versuchen.
Zu Deiner anderen Frage: Ich werde die Ergebnisse (vermutlich als die Charts, die ich abschließend bekomme) auf meinem Blog veröffentlichen: theothersideofbokeh.wordpress.com
der Ansatz war, dass du in deiner xl-Version einmal den Aufbau des Charts mit dem Rekorder aufzeichnest. Dann kann es keine Konflikte zwischen verschiedenen Versionen geben.
Die Befehle für das Tabellenblatt sin "uralt" und damit passen sie alle xl-Versionen der letzten 25 Jahre.
19.12.2017, 16:37 (Dieser Beitrag wurde zuletzt bearbeitet: 19.12.2017, 16:37 von rob70.)
OK ich werd's aufzeichnen. Dann poste ich den Code hier, damit die absoluten Bezüge angepasst werden können, oder?
Vorab sei gesagt, dass ich das Ganze nun noch vereinfacht habe, indem ich zwei Tabellen erstellt habe durch Kopieren von Inhalten, so dass zusammengehörige Werte direkt nebeneinander stehen können. Ich hänge die überarbeitete Beispieldatei, mit deren Hilfe ich das Ganze aufgezeichnet habe auch noch einmal an.
Leider habe ich gerade gemerkt, dass ich vergessen habe, den Titel noch einzufügen. Das wäre noch ein zusätzlicher Wunsch. Das Diagramm könnte man dann z.B. unmittelbar rechts der letzten Spalte der beiden rechten Tabellen einfügen.
es tut mir Leid, ich habe bei neuem drübersehen bemerkt, dass ich leider den falschen Code kopiert habe. Es ist der von einem alten Makro. Der neueste ist der hier:
Code:
Sub Make_Chart()
'
' Make_Chart Makro
'
'
ActiveCell.Offset(1, 1).Range("A1:I1").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Range("Tabelle1!$AA$4:$AI$4")
ActiveSheet.Shapes("Diagramm 1").IncrementLeft 834.4537795276
ActiveSheet.Shapes("Diagramm 1").IncrementTop -282.8571653543
ActiveSheet.Shapes("Diagramm 1").ScaleHeight 0.7894491834, msoFalse, _
msoScaleFromTopLeft
ActiveChart.Axes(xlValue).Select
ActiveChart.Axes(xlValue).MinimumScale = 0
ActiveChart.Axes(xlValue).MaximumScale = 2500
ActiveChart.Axes(xlValue).MajorUnit = 500
ActiveChart.Axes(xlValue).MinimumScale = 200
ActiveChart.Axes(xlValue).MaximumScale = 2200
ActiveChart.Axes(xlValue).MajorUnit = 200
ActiveChart.Axes(xlCategory).Select
ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection(1).XValues = "=Tabelle1!$AA$3:$AI$3"
ActiveChart.SeriesCollection(1).Name = "=Tabelle1!$Z$4"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "=Tabelle1!$Z$9"
ActiveChart.SeriesCollection(2).Values = "=Tabelle1!$AA$9:$AI$9"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).Name = "=Tabelle1!$Z$14"
ActiveChart.SeriesCollection(3).Values = "=Tabelle1!$AA$14:$AI$14"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(4).Name = "=Tabelle1!$AK$4"
ActiveChart.SeriesCollection(4).Values = "=Tabelle1!$AL$4:$AT$4"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(5).Name = "=Tabelle1!$AK$9"
ActiveChart.SeriesCollection(5).Values = "=Tabelle1!$AL$9:$AT$9"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(6).Name = "=Tabelle1!$AK$14"
ActiveChart.SeriesCollection(6).Values = "=Tabelle1!$AL$14:$AT$14"
ActiveChart.SeriesCollection(2).XValues = "=Tabelle1!$AA$3:$AI$3"
ActiveChart.SeriesCollection(4).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
End With
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
.Transparency = 0
End With
ActiveChart.SeriesCollection(5).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
End With
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(253, 99, 99)
.Transparency = 0
End With
ActiveChart.SeriesCollection(6).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(253, 99, 99)
End With
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
.Transparency = 0
End With
ActiveChart.SeriesCollection(4).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText2
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0.6000000238
.Transparency = 0
End With
With Selection.Format.Line
.Visible = msoTrue
.Weight = 2
End With
With Selection.Format.Line
.Visible = msoTrue
.DashStyle = msoLineSysDash
End With
ActiveChart.SeriesCollection(5).Select
With Selection.Format.Line
.Visible = msoTrue
.Weight = 1.75
End With
With Selection.Format.Line
.Visible = msoTrue
.DashStyle = msoLineSysDash
End With
ActiveChart.SeriesCollection(6).Select
With Selection.Format.Line
.Visible = msoTrue
.Weight = 1.75
End With
With Selection.Format.Line
.Visible = msoTrue
.DashStyle = msoLineSysDash
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Format.Line
.Visible = msoTrue
.Weight = 1.75
End With
ActiveChart.SeriesCollection(2).Select
With Selection.Format.Line
.Visible = msoTrue
.Weight = 1.75
End With
ActiveChart.SeriesCollection(3).Select
With Selection.Format.Line
.Visible = msoTrue
.Weight = 1.75
End With
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 10
End Sub
Sub Neu_Aufbauen()
'ActiveCell auf Titel, z.B. A3
Dim Col As Range
Range("A3").Select ' <<<<<<<<<<< setzt >>>>>>>>>>>
r = ActiveCell.Row
Set Col = Range(Cells(r, 4), Cells(r, "R")).SpecialCells(xlCellTypeConstants).EntireColumn
entschuldige, heute war ich den ganzen Tag voll beschäftigt und hatte gar keine Zeit. Auf den ersten Blick kapiere ich auch nicht, was zu tun ist, aber ich werde das hoffentlich in den nächsten Tagen hinbekommen. Danke auf jeden Fall einmal mehr für die Hilfe.
![[-]](https://www.clever-excel-forum.de/images/collapse.png)