Pivot Chart Lauzeit Fehler -21474677259 (80004005)
25.10.2014 11:27:56
thuburbo
Mein Ziel: Erstellung einer Sub zu Pivot Chart - Erzeugung (code s.u.) die mehrmals aufgerufen werden kann.
In einem Reiter Tabelle1 habe ich die u.g. Daten eingepflegt und als Bereich "Jahr" benannt.
Die Sub funktioniert beim ersten Aufruf Einwandfrei. Jedoch beim wieder wählen von Tabelle1 und der erneuten Ausführung (beim 2 oder 3 Mal) erzeugt Excel
Laufzeitfehler '-21474677259 (80004005)': Die Methode 'SetSourceData' für das Objekt '_Chart' ist fehlgeschlagen.
Der Debugger bleibt bei der Zeile SetSourceData (beim zweiten oder dritten Aufruf) hängen.
Range "Jahr" in Tabelle1:
| Item | Art | Januar | Februar | März | April | Mai | Juni | Juli | August |
|---|---|---|---|---|---|---|---|---|---|
| Monat | Mat | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 |
| Stunden | HR | 5 | 34 | 3 | 5 | 43 | 5 | 21 | 67 |
Private Sub CB_Pivot_Click()
Dim DatenTabelle As Range
Dim i As Integer
Dim MeinPivot As String
Dim ueberschrift As String
Dim MeinReiter As Worksheet
Dim pc As PivotCache
'On Error GoTo Fehler
Set DatenTabelle = ActiveSheet.Range("Jahr")
Set MeinReiter = Worksheets.Add(after:=ActiveSheet)
MeinPivot = MeinReiter.Name & "Pivot"
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
DatenTabelle, Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:=MeinReiter.Name & "!R3C1", TableName:=MeinPivot, _
DefaultVersion:=xlPivotTableVersion14
With MeinReiter.PivotTables(MeinPivot).PivotFields("Art")
.Orientation = xlPageField
.Position = 1
End With
With MeinReiter.PivotTables(MeinPivot).PivotFields("Item")
.Orientation = xlRowField
.Position = 1
End With
For i = 2 + 1 To DatenTabelle.Columns.Count
ueberschrift = DatenTabelle.Cells(1, i).Value
MeinReiter.PivotTables(MeinPivot).AddDataField MeinReiter.PivotTables( _
MeinPivot).PivotFields(ueberschrift), "Sum " & ueberschrift, xlSum
Next i
With MeinReiter.PivotTables(MeinPivot).PivotFields("Art")
.ClearAllFilters
For i = 1 To .PivotItems.Count
If StrComp(.PivotItems(1), "HR", vbTextCompare) = 0 Then
.CurrentPage = "HR"
Exit For
End If
Next
End With
Erstelle_Pivot_Grafik MeinReiter.PivotTables(MeinPivot)
Set MeinReiter = Nothing
Set pc = Nothing
Exit Sub
'Fehler:
' MsgBox "Konnte Pivot Tabelle nicht erstellen", vbCritical, "FEHLER"
End Sub
Sub Erstelle_Pivot_Grafik(PT As PivotTable) 'as chart
Dim MeinDiagramm As Chart
Dim rngChart As Range
DoEvents
Set MeinDiagramm = PT.Parent.Parent.Charts.Add(after:=PT.Parent)
Set rngChart = PT.TableRange1
With MeinDiagramm
.SetSourceData rngChart
.ChartType = xlAreaStacked
.ShowAxisFieldButtons = False
.ShowValueFieldButtons = False
.PlotBy = xlRows
.Refresh
End With
Set rngChart = Nothing
Set MeinDiagramm = Nothing
End Sub