AW: Diagramme ohne Verknüpfung kopieren
16.05.2007 23:06:16
ingUR
Hallo, Martin,
das folgende Makro ist als Standardmodul in einer Arbeitsmappe einzubauen, die das "Orignal" des Diagramms enthält.
Hier ist es die "Mappe1" mit dem Tabellenblatt "Tabelle1" (ws0), wo die Musterkopie des Diagramms (ChartObject(1)) liegt.
Die Daten, hier zwei Datenreihen, stehen in den Spalten A bis C (X-Werte, Y1, Y2) in den Zeilen 2 bis 16 (XWerte:=R2C1:R16C1; Y1Werte:=R2C2:R16C2; Y2Werte:=R2C3:R16C3).
Die Bereiche gelten auch für die Tabellen, in die das Diagramm kopiert werden sollen, sofern keine weiteren Veränderungen vorgenommen werden.
Um das Makro zu starten, ist auf das Tabellenblatt in der Arbeitmappe zu wechseln, auf dem das Diagramm kopiert werden soll.
Sub KopiereDiagramm()
Dim chtObj As ChartObject, ws0 As Worksheet, ws1 As Worksheet, TName As String
'Tabelle mit "Original"-Diagramm
Set ws0 = Workbooks("Mappe1").Worksheets("Tabelle1")
'aktive Tabelle auf der das "Original"-Diagramm kopiert werden soll
Set ws1 = ActiveWorkbook.ActiveSheet
Set chtObj = ws0.ChartObjects(1)
chtObj.Activate
With ActiveChart.ChartArea
.Select
.Copy
End With
ws1.Activate
ws1.Range("D2").Select
ActiveSheet.Paste
TName = "=" & ws1.Name & "!"
ActiveSheet.ChartObjects(1).Activate
With ActiveChart
.SeriesCollection(1).XValues = TName & "R2C1:R16C1"
.SeriesCollection(1).Values = TName & "R2C2:R16C2"
.SeriesCollection(1).Name = TName & "R1C2"
.SeriesCollection(2).XValues = TName & "R2C1:R16C1"
.SeriesCollection(2).Values = TName & "R2C3:R16C3"
.SeriesCollection(2).Name = TName & "R1C3"
End With
Range("D2").Select
Set ws1 = Nothing
Set ws0 = Nothing
Set chtObj = Nothing
End Sub
Mit einer Schleife über alle im Digrammbefindlichen Datenreihen könnte die Umschreibung des Tabellennamens in der Referenzz erledigt werden, wenn die Datenreihen ebenfalls in gesetzmäßig aufeinaderfolgenden Spalten angeordnet sind.
Varible Zeilenanzahl (unterschiedliche Datenanzahl) können durch eine entsprechende Verkettung der Bezugsangaben berücksichtigt werden, z.B.: "R2C" & s & ":R" & maxRow & "C" & s , wobei s für die Laufvariable zur Kennzeichnung der vorhandenne Datenreihen eingesetzt ist:
maxS = chtObj.Chart.SeriesCollection.Count 'maximale Anzahl der Datenreihen im Diagramm
maxRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row 'maximale Anzah der Zeilen in der _
Datenspalte
For i = 1 To maxS
s = i + 1
.SeriesCollection(i).XValues = TName & "R2C1:R" & maxRow & "C1"
.SeriesCollection(i).Values = TName & "R2C" & s & ":R" & maxRow & "C" & s
.SeriesCollection(i).Name = TName & "R1C" & s
Next i
Gruß,
Uwe