Code nicht erweiterbar?
04.09.2013 10:22:19
Hendrik
ich würde gerne meinen bisherigen Code erweitern (und zwar um das Fettmarkierte):
Sub prcSynchronizePivotTabs()
Dim pgfPageField(1 To 3) As Object
Dim lngPGFPosition(1 To 3) As Long
Dim i As Long
On Error GoTo ErrorHandler
Set pgfPageField(1) = Me.PivotTables(1).PageFields("Kalenderwochen")
lngPGFPosition(1) = pgfPageField(1).Position
Set pgfPageField(2) = Me.PivotTables(1).PageFields("Kunde Leistungsort")
lngPGFPosition(2) = pgfPageField(2).Position
Set pgfPageField(3) = Me.PivotTables(1).PageFields("Kunden Nr.")
lngPGFPosition(3) = pgfPageField(3).Position
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Cursor = xlWait
'Synchronisieren von KW mit Kalenderwoche
On Error Resume Next
prcSynchronizeMe
'For i = 1 To TabP1.PivotTables(1).PivotFields("Kalenderwochen").PivotItems.Count
' TabP1.PivotTables(1).PivotFields("KW").PivotItems(i).Visible = TabP1.PivotTables(1). _
PivotFields("Kalenderwochen").PivotItems(i).Visible
'Next i
On Error GoTo ErrorHandler
TabP1.PivotTables(1).PivotCache.Refresh
TabP3.PivotTables(1).PivotFields("Kunden Nr.").CurrentPage = CStr(Me.PivotTables(1). _
PivotFields("Kunden Nr.").CurrentPage.Value)
TabP4.PivotTables(1).PivotFields("Kunden Nr.").CurrentPage = CStr(Me.PivotTables(1). _
PivotFields("Kunden Nr.").CurrentPage.Value)
TabP21.PivotTables(1).PivotFields("Kunden Nr.").CurrentPage = CStr(Me.PivotTables(1). _
PivotFields("Kunden Nr.").CurrentPage.Value)
TabP22.PivotTables(1).PivotFields("Kunden Nr.").CurrentPage = CStr(Me.PivotTables(1). _
PivotFields("Kunden Nr.").CurrentPage.Value)
TabP23.PivotTables(1).PivotFields("Kunden Nr.").CurrentPage = CStr(Me.PivotTables(1). _
PivotFields("Kunden Nr.").CurrentPage.Value)
TabP24.PivotTables(1).PivotFields("Kunden Nr.").CurrentPage = CStr(Me.PivotTables(1). _
PivotFields("Kunden Nr.").CurrentPage.Value)
TabP25.PivotTables(1).PivotFields("Kunden Nr.").CurrentPage = CStr(Me.PivotTables(1). _
PivotFields("Kunden Nr.").CurrentPage.Value)
TabP26.PivotTables(1).PivotFields("Kunden Nr.").CurrentPage = CStr(Me.PivotTables(1). _
PivotFields("Kunden Nr.").CurrentPage.Value)
TabP27.PivotTables(1).PivotFields("Kunden Nr.").CurrentPage = CStr(Me.PivotTables(1). _
PivotFields("Kunden Nr.").CurrentPage.Value)
TabP3.PivotTables(1).PivotFields("Kunde Leistungsort").CurrentPage = CStr(Me.PivotTables(1). _
_
PivotFields("Kunde Leistungsort").CurrentPage.Value)
TabP4.PivotTables(1).PivotFields("Kunde Leistungsort").CurrentPage = CStr(Me.PivotTables(1). _
_
PivotFields("Kunde Leistungsort").CurrentPage.Value)
On Error Resume Next
pgfPageField(1).Orientation = xlColumnField 'Umdefinieren PageField 'Kalenderwochen' wg. _
Excel2003-bug
For i = 1 To TabP1.PivotTables(1).PivotFields("Kalenderwochen").PivotItems.Count
TabP3.PivotTables(1).PivotFields("Kalenderwochen").PivotItems(i).Visible = TabP1. _
PivotTables(1).PivotFields("Kalenderwochen").PivotItems(i).Visible
TabP4.PivotTables(1).PivotFields("Kalenderwochen").PivotItems(i).Visible = TabP1. _
PivotTables(1).PivotFields("Kalenderwochen").PivotItems(i).Visible
Next i
For i = 1 To 3
pgfPageField(i).Orientation = xlPageField 'Zurücksetzen PageField 'Kalenderwochen'
pgfPageField(i).Position = lngPGFPosition(i)
Next i
On Error GoTo ErrorHandler
TabP3.prcSynchronizeMe
TabP3.PivotTables(1).PivotCache.Refresh
TabP4.prcSynchronizeMe
TabP4.PivotTables(1).PivotCache.Refresh
prcFormatPivotChart ("Diagramm 1")
ErrorHandler:
Application.ScreenUpdating = True
Application.Cursor = xlDefault
Application.EnableEvents = True
End Sub
Leider habe ich das Problem, dass es für TabP21 noch wunderbar funktionert, für die weiteren Tabellen aber nicht. Die Pivottabellen sind eigentlich alle wie TabP21 aufgebaut. Wenn ich weitere Felder einfüge, dann funktioniert nicht nur die Synchronisierung nicht, sondern auch das folgende Makro für die Formatierung einer Grafik funktioniert nicht mehr.
Ich bin ratlos, woran das liegen kann. Ist der Code der Synchronisierung auf eine Anzahl an Zeilen begrenzt?