Charts ohne Nullwerte
28.06.2006 11:11:44
Olaf
ich wollte Charts erstellen, bei dem keine Nullwerte ausgegeben werden. Sonst hat man (vor allem bei Kuchendiagrammen) immer so ekelige Striche und die Kategoriebezeichnung wird auch eingeblendet. Das hat zur Folge, daß man bei vielen Merkmalen den Überblick verliert.
Ihr benötigt für das Skript ein Tabellenblatt mit dem Namen "Ablage". Hier werden Zwischenwerte gespeichert. Könnt ihr ja ausblenden.
Also nun der Code:
Public
Sub diag_ohne_null()
Dim i, j As Integer
Dim x As Integer
Dim namespalte As Range
Dim namen(), werte(), rng As Range
Dim aktuellesblatt As Worksheet
Set aktuellesblatt = ActiveSheet
i = -1
WerteBox_marker:
Set wertebox = Application.InputBox(prompt:="Bitte den Datenbereich wählen", Title:="Datenbereich", Type:=8)
If wertebox Is Nothing Then
fehler = MsgBox("Kein Bereich gewählt. Abbrechen?", vbYesNo, "Fehler!")
If fehler = vbYes Then
Exit Sub
Else
GoTo WerteBox_marker
End If
End If
SpalteBox_marker:
Set spaltebox = Application.InputBox(prompt:="Bitte die Beschriftung wählen", Title:="Beschriftungsbereich", Type:=8)
If spaltebox Is Nothing Then
fehler = MsgBox("Keinen Bereich angegeben. Abbrechen?", vbYesNo, "Fehler!")
If fehler = vbYes Then
Exit Sub
Else
GoTo SpalteBox_marker
End If
End If
x = spaltebox.Column - wertebox.Column
For Each rng In wertebox
If rng.Value <> 0 Then
i = i + 1
'rng.Activate
ReDim Preserve werte(i)
ReDim Preserve namen(i)
Set werte(i) = rng
Set namen(i) = rng.Offset(0, x)
Else
End If
Next rng
Worksheets("Ablage").Activate
ActiveSheet.UsedRange.Delete
Range("a1").Activate
For i = 0 To UBound(werte)
ActiveCell.Offset(0, 1).Value = werte(i)
ActiveCell.Value = namen(i)
ActiveCell.Offset(1, 0).Select
Next i
ActiveSheet.UsedRange.Select
Charts.Add
ActiveChart.ChartType = xl3DPieExploded
ActiveChart.Location Where:=xlLocationAsObject, Name:="Nutzungsarten"
ActiveChart.HasTitle = False
ActiveChart.HasLegend = False
ActiveChart.SeriesCollection(1).ApplyDataLabels AutoText:=True, LegendKey:= _
False, HasLeaderLines:=True, ShowSeriesName:=False, ShowCategoryName:= _
True, ShowValue:=True, ShowPercentage:=False, ShowBubbleSize:=False
End Sub
anstelle des xl3DPieExploded kann selbstredend jeder DiagTyp stehen.
Greetz
Olzo