AW: Legende im Blasen-Diagramm
21.07.2006 18:00:29
fcs
Hallo Jo,
leider hat der MS-Diagramm-Assistent hier tatsächlich eine völlig andere Vorstellung wie so ein Blasendiagramm aussehen sollte. Ich habe mir für diesen Zweck ein Makro erstellt, das aus selektierten Daten ein entsprechendes Blasendiagramm generiert.
Gruß
Franz
Sub Blasendiagramm_mit_Reihe_je_Zeile()
' Erzeugt aus selektierten Daten ein Blasendiagramm mit einer Reihe pro Zeile
' Selektion muss beinhalten:
' 1. Zeile Spalten-Überschriften (werden für Diagrammbeschriftung vorgeschlagen)
' 1. Spalte Kategorien (Beschriftung für Legende, je Kategorie wird eine Datenreihe erzeugt
' 2. Spalte X-Werte
' 3. Spalte Y-Werte
' 4. Spalte Blasengröße
Dim Daten As Range, wks As Worksheet, Reihe As Series
Set wks = ActiveSheet
Set Daten = Selection
Charts.Add
ActiveChart.ApplyCustomType ChartType:=xlBubble
ActiveChart.Location Where:=xlLocationAsNewSheet
With wks
ActiveChart.SetSourceData Source:=.Range(.Cells(Daten.Row + 1, Daten.Column), _
.Cells(Daten.Row + Daten.Rows.Count - 1, Daten.Column + 3)), PlotBy:=xlRows
End With
Application.ScreenUpdating = False
For i = ActiveChart.SeriesCollection.Count To 2 Step -1
ActiveChart.SeriesCollection(i).Delete
Next
For i = 1 To Daten.Rows.Count - 1
Set Reihe = ActiveChart.SeriesCollection(i)
With Reihe
.Name = "=" & wks.Name & "!R" & Daten.Row + i & "C" & Daten.Column
.XValues = "=" & wks.Name & "!R" & Daten.Row + i & "C" & Daten.Column + 1
.Values = "=" & wks.Name & "!R" & Daten.Row + i & "C" & Daten.Column + 2
.BubbleSizes = "=" & wks.Name & "!R" & Daten.Row + i & "C" & Daten.Column + 3
.ApplyDataLabels Type:=xlDataLabelsShowBubbleSizes 'Wert Blasengröße wird angezeigt
End With
If i <> Daten.Rows.Count - 1 Then
ActiveChart.SeriesCollection.NewSeries
End If
Next
Application.ScreenUpdating = True
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = InputBox("Diagrammtitel", "Neues Diagramm", Daten(1, 4))
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = InputBox("Beschriftung X-Achse:", "Neues Diagramm", Daten(1, 2))
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = InputBox("Beschriftung Y-Achse:", "Neues Diagramm", Daten(1, 3))
End With
End Sub