Pivot Items in VBA ansteuern
16.12.2014 15:16:55
Chris
ich habe folgendes Problem. Ich möchte bei einer jeden Monat die Bezugstabelle meiner Pivots mit neuen Daten füllen und dann immer nur die letzten 6 Monate anzeigen. Da es über 30 Pivottabellen sind möchte ich dies automatisch mit einem VBA Makro machen.
Anbei der Code mit dem ich das bis jetzt umgesetzt habe:
'Loop through all sheets to set the date filter for each pivot table to the last 6 months
all_months = Range("months_reference_data").Value
For wks_count = 6 To ActiveWorkbook.Worksheets.Count - 5
ActiveWorkbook.Worksheets(wks_count).Select
ActiveWorkbook.Worksheets(wks_count).Activate
For pt_count = 1 To ActiveSheet.PivotTables.Count
With ActiveSheet.PivotTables(pt_count)
.PivotCache.MissingItemsLimit = xlMissingItemsNone
.PivotFields("Date").ClearAllFilters
.PivotFields("Date").AutoSort xlAscending, "Date"
.PivotFields("Date").PivotItems("(blank)").Visible = False
If all_months > 6 Then
For outdated_count = (all_months * (-1)) To -6
On Error Resume Next
.PivotFields("Date").PivotItems(DateAdd("m", outdated_count, Range(" _
Date_TODAY").Value)).Visible = False
Next
End If
End With
Next
Next
Leider wirft er immer einen Fehler (1004 Die PivotItems-Eigenschaft des PivotField-Objektes kann nicht zugeordnet werden), sobald ich 6 Monate in meine Bezugstabelle gesteckt habe und zwar genau in der Zeile mit diesem Code:
.PivotFields("Date").PivotItems(DateAdd("m", outdated_count, Range("Date_TODAY").Value)). _
Visible = False
Wenn ich weniger als 6 Monate (also zb 5) dann kommt kein Fehler. Und wenn ich vorher OnError resume Next setze, dann läuft der Code durch und tut auch eigentlich genau das was er soll, nur er braucht dafür ca. 10 Minuten. Daher würde ich das Problem gerne lösen und Error resume next weglassen.
zusätzlich info (falls wichtig):
In der Zelle der Range "Date_TODAY" steht das Datum in der Form 01.12.2014 aber mit einem Verweis auf eine andere Zelle
=DATUM(LINKS(gc_key_date;4);RECHTS(gc_key_date;2);1)
Wäre schön wenn ihr mir weiterhelfen könntet!
Besten Dank und Grüße
Chris