Pivottabelle löschen
Reinhard
mit nachfolgendem Code wir eine PT erzeugt, der Code klappt soweit gut.
Nur habe ich jetzt ein Klassenmodul geschrieben was überwacht ob an den Basis-Daten der Pt etwas geändert wurde, also das Change-Erignis auswertet.
Dann wird die nachfolgende Prozedur nochmals aufgerufen. Leider kommt da Fehler 1004, also Vba will was machen kann/darfs aber nicht.
Ich mutmaße stark ich muß die "alte" PT liquidieren, dann müßte es klappen so wie vorher als es noch keine PT gab in der neu erstellten Mappe, aber wie?
Das Blatt auf dem sie erstellt wurde zu löschen bringt nix:
With Workbooks("Ergebnistabelle.xls")
For Each wks In .Worksheets
If wks.Name = "PT" Then
Application.DisplayAlerts = False
.Worksheets("PT").Delete
Application.DisplayAlerts = True
Exit For
End If
Next wks
Der Fehler 1004 kommt hier, gleich nach der For-Schleife von eben:
.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"PivotQuelle").CreatePivotTable TableDestination:="", TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
Ich mutmaße als Laie der bis vor 4 Tagen noch nie eine PT gebastelt hat, in Vba schon gar nicht und dem XL 2007 sowieso suspekt ist, in der Hilfe finde ich kaum was, will meine XL2000-hilfe zurückhaben *forder*,
daß ich da irgendwie Pivotxxx.delete benutzen müßte, ich weiß leider nicht wie :-(
Danke für die Aufmerksamkeit.
Gruß
Reinhard
Sub Pivot2007(Blatt As Worksheet, ByVal Nr As Integer)
Dim Bereich As Range, PT As PivotTable, arrSpalten, S As Integer
Dim Titel, arrTitel, wks As Worksheet
arrTitel = Array(2, 3, 5, 7, 8, 13, 12)
With ThisWorkbook.Worksheets("Sprachen").Range("Sp_Titel")
Titel = .Offset(, Nr - 1).Resize(, 1)
End With
Set Bereich = Blatt.UsedRange
ActiveWorkbook.Names.Add Name:="PivotQuelle", RefersTo:=Bereich, Visible:=True
Bereich.Select
With Workbooks("Ergebnistabelle.xls")
For Each wks In .Worksheets
If wks.Name = "PT" Then
Application.DisplayAlerts = False
.Worksheets("PT").Delete
Application.DisplayAlerts = True
Exit For
End If
Next wks
.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"PivotQuelle").CreatePivotTable TableDestination:="", TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.Name = "PT"
With .Worksheets("PT")
.PivotTableWizard TableDestination:=.Cells(3, 1)
.Cells(3, 1).Select
.PivotTables("PivotTable1").RowGrand = False
For S = 0 To UBound(arrTitel) - 1
.PivotTables("PivotTable1").PivotFields(Titel(arrTitel(S), 1)).Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
Next S
.PivotTables("PivotTable1").AddFields RowFields:=Array(Titel(2, 1), _
Titel(3, 1), Titel(5, 1), Titel(7, 1), Titel(8, 1), Titel(13, 1)), ColumnFields:= _
Titel(12, 1)
.PivotTables("PivotTable1").PivotSelect "", xlDataAndLabel, True
.PivotTables("PivotTable1").Format xlTable2
' With ActiveSheet.PivotTables("PivotTable1").PivotFields(Titel(12, 1))
' .PivotItems("(Leer)").Visible = False
' End With
.PivotTables("PivotTable1").TableStyle2 = "PivotStyleMedium2"
.PivotTables("PivotTable1").PivotFields(Titel(2, 1)).LayoutBlankLine = True
With .PivotTables("PivotTable1").PivotFields(Titel(12, 1))
.Orientation = xlDataField
.NumberFormat = "#.##0,00"
End With
.Columns("G:H").NumberFormat = "#,##0.00"
.Rows("2:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("F8").Copy
Range("F1:F3").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
.Range("F1").FormulaR1C1 = "*today()-50"
.Range("F1").FormulaR1C1 = "=+TODAY()-50"
.Range("G1").FormulaR1C1 = "more than 30 days overdue"
.Range("F1").Copy
Range("F2:F3").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With .Range("F1:F3").Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
.Range("F2").FormulaR1C1 = "=+TODAY() -1"
.Range("G2").FormulaR1C1 = "1 to 30 days overdue"
.Range("F3").FormulaR1C1 = "=+TODAY() +10"
.Range("G3").FormulaR1C1 = "not due"
With .Columns("F:F")
.FormatConditions.AddIconSetCondition
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1)
.ReverseOrder = False
.ShowIconOnly = False
.IconSet = ActiveWorkbook.IconSets(xl3Signs)
End With
With .FormatConditions(1).IconCriteria(2)
.Type = xlConditionValuePercent
.Value = 33
.Operator = 7
End With
With .FormatConditions(1).IconCriteria(3)
.Type = xlConditionValuePercent
.Value = 67
.Operator = 7
End With
' Cells.FormatConditions.Delete ' was soll da gelöscht werden?
.FormatConditions.AddIconSetCondition
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1)
.ReverseOrder = False
.ShowIconOnly = False
.IconSet = ActiveWorkbook.IconSets(xl3Signs)
End With
With .FormatConditions(1).IconCriteria(2)
.Type = xlConditionValueFormula
.Value = "=TODAY()-30"
.Operator = 5
End With
With .FormatConditions(1).IconCriteria(3)
.Type = xlConditionValueFormula
.Value = "=TODAY()"
.Operator = 5
End With
End With
'Hier soll der Mitarbeiter die Ausgabesprache wählen
'Dann werden einzelne Bezeichnungen ausgewechselt
'die PT wird aktulisiert, das geht so
'For Each pt In Sheets("Sheet2").PivotTables
'With pt
'.PivotTableWizard SourceType:=xlDatabase, _
'SourceData:="PivotQuelle"
'End With
'pt.RefreshTable
'Next pt
End With
End With
End Sub