AW: XY Diagramm Problem
30.04.2007 20:09:00
fcs
Hallo Safyan,
dass ist leider ein Problem des Diagramm-Assistenten (zumindest in der Deitschen Version). Hat mich auch schon zur Weißglut gebracht.
Ich hab mir deshalb die folgenden Makros gestrickt, die den Diagrammmüll in die gewünschte Form bringen.
Beim Blasendiagramm funktioniert es nicht 100% (zumindest unter Excel97 nicht) aber es werden zumindest die Datenreihen entsprechend angelegt. Die Verknüpfung für die Blasengröße muss ich immer manuell nachbereiten.
Gruß
Franz
Sub Diagramm_Blasen()
' Blasendiagramm Makro
' Erstellt aus dem Selektierten Bereich ein Blasendiagramm
' Selektierter Bereich muss 4 Spalten und mindestens 2 Zeilen beinhalten
' 1. Zeile enthält die Beschriftungen für die Achsen und die Blasen
' 1. Spalte enthält ab Zeile 2 die Namen der Reihen
' 2. Spalte enthält ab Zeile 2 die Daten der X-Achse
' 3. Spalte enthält ab Zeile 2 die Daten der Y-Achse
' 4. Spalte enthält ab Zeiel 2 die Daten für die Blasengröße
Dim wks As Worksheet, Diag As Chart, Reihe As Series, Bereich As Range
Dim Zeile As Long, Spalte As Integer
Set wks = ActiveSheet
Set Bereich = Selection
Zeile = Bereich.Row
Spalte = Bereich.Column
Charts.Add
Application.ScreenUpdating = False
Set Diag = ActiveChart
With Diag
.SetSourceData Source:=Bereich, PlotBy:= _
xlRows
.ChartType = xlBubble
.Location Where:=xlLocationAsNewSheet
Application.ScreenUpdating = True
.Name = InputBox("Diagramm-Name", _
"Blasendiagramm erstellen", .Name)
Application.ScreenUpdating = False
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Bereich(1, 2)
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Bereich(1, 3)
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = True
.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic
.HasLegend = True
.Legend.Position = xlTop
'von Excel erzeugte Datenreihen löschen
For i = .SeriesCollection.Count To 1 Step -1
.SeriesCollection(i).Delete
Next
'Neue Datenreihen erzeugen
For i = 1 To Bereich.Rows.Count - 1
.SeriesCollection.NewSeries
Set Reihe = .SeriesCollection(i)
Reihe.Name = "='" & wks.Name & "'!R" & Zeile + i & "C" & Spalte
Reihe.XValues = "='" & wks.Name & "'!R" & Zeile + i & "C" & Spalte + 1
Reihe.Values = "='" & wks.Name & "'!R" & Zeile + i & "C" & Spalte + 2
'Nachfolgende Zeile zum Eintrag der Formel für Blasengröße funktioniert unter EXCEL 97 nicht
Reihe.BubbleSizes = "='" & wks.Name & "'!R" & Zeile + i & "C" & Spalte + 3
'Blasengröße-Werte aus Zellen eintragen, Diagramm Aktualisiert sich nicht mehr automatisch!!!
' ggf. entsprechende Bezüge für die Blasengröße unter Datenquelle von Hand herstellen
' Reihe.BubbleSizes = "={" & wks.Cells(Zeile + i, Spalte + 3) & "}"
Next
.HasTitle = True
Application.ScreenUpdating = True
.ChartTitle.Characters.Text = InputBox("Diagramm-Titel", _
"Blasendiagramm erstellen", "Diagramm-Titel")
.ApplyDataLabels Type:=xlDataLabelsShowBubbleSizes, LegendKey:=False
End With
End Sub
Sub Diagramm_PunktXY()
' Erstellt aus dem Selektierten Bereich ein Punkt XY-Diagramm jede Zeile eine Datenreihe
' Selektierter Bereich muss 3 Spalten und mindestens 2 Zeilen beinhalten
' 1. Zeile enthält die Beschriftungen für die Achsen und die Blasen
' 1. Spalte enthält ab Zeile 2 die Namen der Reihen
' 2. Spalte enthält ab Zeile 2 die Daten der X-Achse
' 3. Spalte enthält ab Zeile 2 die Daten der Y-Achse
Dim wks As Worksheet, Diag As Chart, Reihe As Series, Bereich As Range
Dim Zeile As Long, Spalte As Integer
Set wks = ActiveSheet
Set Bereich = Selection
Zeile = Bereich.Row
Spalte = Bereich.Column
Charts.Add
Application.ScreenUpdating = False
Set Diag = ActiveChart
With Diag
.SetSourceData Source:=Bereich, PlotBy:= _
xlRows
.ChartType = xlXYScatter
.Location Where:=xlLocationAsNewSheet
Application.ScreenUpdating = True
.Name = InputBox("Diagramm-Name", _
"Punkt XY Diagramm erstellen", .Name)
Application.ScreenUpdating = False
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Bereich(1, 2)
With .Axes(xlCategory)
.MinimumScaleIsAuto = True
.MaximumScaleIsAuto = True
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAxisCrossesAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
End With
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Bereich(1, 3)
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = True
.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic
.HasLegend = True
.Legend.Position = xlRight
'von Excel erzeugte Datenreihen löschen
For i = .SeriesCollection.Count To 1 Step -1
.SeriesCollection(i).Delete
Next
'Neue Datenreihen erzeugen
For i = 1 To Bereich.Rows.Count - 1
.SeriesCollection.NewSeries
Set Reihe = .SeriesCollection(i)
Reihe.Name = "=" & wks.Name & "!R" & Zeile + i & "C" & Spalte
Reihe.XValues = "=" & wks.Name & "!R" & Zeile + i & "C" & Spalte + 1
Reihe.Values = "=" & wks.Name & "!R" & Zeile + i & "C" & Spalte + 2
Reihe.MarkerSize = 10
Next
.HasTitle = True
Application.ScreenUpdating = True
.ChartTitle.Characters.Text = InputBox("Diagramm-Titel", _
"Punkt XY Diagramm erstellen", "Diagramm-Titel")
End With
End Sub