meerdere draaitabellen op een pagina

[jheesterbeek]

zet de aangepaste file nogeens op het forum.....

 

[coma]

te groot

als ik hem in z'n geheel wil verzenden is ie te groot. gezipped is ie nog 450 kb! als ik wat tabbladen verwijder wordt ie natuurlijk kleiner maar dan moet ik straks het gehele bestand weer in orde zien te krijgen en of dat me lukt? wat wil je? toch maar een kleiner bestand zodat je kan zien wat er aan de hand is?

 

[jheesterbeek]

Het gaat alleen om het principe/de werkwijze, tien regels aan data voor de verschillende draaitabellen is voldoende (wel met de medewerker waar het mis gaat).
Alles wat niet met de draaitabel (of de bron) te maken heeft kun je ook verwijderen. Verder kun je alle formules verwijderen om hem kleiner te maken.

Als we een oplossing vinden, kun je die toepassen op je brondocument.

 

[coma]

hier is tie dan

zoals je ziet werkt het hier helemaal niet! alvast bedankt!

 

[jheesterbeek]

Hoi Coma,

ik heb vanalles geprobeert, maar krijg je versie niet werkend. Om te proberen heb ik het origineel van wigi ook geprobeert, maar die doet het bij mij ook niet.
Ik denk dat we wigi even om hulp moeten vragen, of een andere manier gebruiken..

 

[coma]

ok!

OK! ik hoor het wel! Bedankt alvast!

 

[Wigi]

Met enige vertraging door de drukke periode, hier dan:

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Application.EnableEvents = False
    Dim Pt As PivotTable, choice As String
    For Each Pt In ActiveSheet.PivotTables
        If Pt.Name <> Target.Name Then
             choice = Target.PivotFields("Medewerker").CurrentPage
             Pt.PivotFields("Medewerker").CurrentPage = choice
        End If
        Pt.Update    'dit is nieuw
    Next Pt
Application.EnableEvents = True
Cells.EntireColumn.AutoFit
End Sub

Pt.Update    'dit is nieuw

heb ik er bijgezet. Nu zou het moeten lukken.

Echter, zonder deze code lukte het ook reeds, ik heb gewoon de draaitabellen geupdated (het vraagteken aanklikken). Om zeker te zijn, dan maar die extra regel code.

Wigi

 

[Twet]

vba bij aanpassen verschillende draaitabellen

Ik probeer deze macro ook toe te passen, maar het verschil is dat mijn draaitabellen op verschillende werkbladen staan. Welke aanpassing moet ik maken zodat de macro werkt? Ik ben zelf al aan het proberen geweest, maar ik kom er niet uit.

Twet

 

[pinobird]

Ik kom er niet uit..... help aub

Ik zit met een soortgelijkprobleem als de posters hiervoor. Bij mij is het echter iets complexer, denk ik, omdat ik met meerdere filters werk.

Ik krijg echter de vba voor de eerste filter al niet werkend laat staan voor de rest.

Wat wil ik bereiken:
Als de filtervelden bij de eerste draaitabel gewijzigd worden moet dit voor alle andere draaitabellen op dezelfde tab ook op dezelfde manier gebeuren.

Nog mooier zou het zijn als dit ook zou gelden voor draaitabellen die ik op andere tabs wil zetten.

Kan iemand mij helpen?

Groeten,
Hans

 

[cow18]

in Thisworkbook

Option Explicit
Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
  Application.EnableEvents = False
  On Error GoTo einde
  UpdatenAlleDraaitabellen Target.PivotFields(MijnPaginaVeld).CurrentPage
einde:
  Application.EnableEvents = True
End Sub

in een gewone module

Option Explicit

Public Const MijnPaginaVeld As String = "Bij welke directie werk je?"

Sub UpdatenAlleDraaitabellen(keuze As String)

  Application.EnableEvents = False

  Dim Sh As Worksheet, Pt As PivotTable, choice As String
  For Each Sh In Sheets
    For Each Pt In Sh.PivotTables
      Pt.PivotFields(MijnPaginaVeld).CurrentPage = keuze
      Pt.Update                                            'dit is nieuw
    Next Pt
    Cells.EntireColumn.AutoFit
  Next
  Application.EnableEvents = True
End Sub

Sub eventson()
  Application.EnableEvents = True
End Sub

die laatste macro eventson dient voor het geval je events uitgeschakeld zijn om ze terug in te schakelen.
Ik veronderstel dat deze macros soms teveel zouden werken, dus misschien zie je ze liever achter een knop ?

 

[pinobird]

Hoi Cow18,

Ik heb je codes geplakt. Ik krijg e.e.a. echter niet werkend. Moet ik nog iets activeren? Wellicht kun je mijn bestandje posten met daarin de code zoals jij hem werkend hebt gekregen.

Verder vraag ik me af of de code ook gaat werken al ik een selectie in het tweede of derde selectieveld maak? Ik kwam die veldnaam namelijk niet tegen in de code.

In ieder geval vast enorm bedankt voor het meedenken.

Hans

 

[cow18]

meerdere items vormt voorlopig nog een probleem van blad1 naar draaitabel, omgekeerd lukt wel, waarom weet ik nog eventjes niet, daar zoek ik vanavond op verder tenzij iemand anders het overneemt. Ik moet er nu van door

 

[pinobird]

Cow18,

Geweldig. Ik wacht geduldig af.

Ik heb je bestandje nog even bekeken. Ik denk dat we een klein verschil hebben in wat ik bedoel. Het gaat er mij niet om dat ik in één filter meerdere selecties kan maken, maar dat ik meerdere filters kan gebruiken.

In bijgaand bestand heb ik de eerdere code van jou verwerkt. Die werkt nu. Zoals je ziet heb ik echter 3 filters (directie, team, afdeling). Bij directie werkt het nu, maar ik wil voor de velden team en afdeling hetzelfde.

Ik hoop dat ik zo duidelijk ben geweest.

Hans

 

[cow18]

meerdere filters met 1 keuze per filter
zie bijlage
blijkbaar krijg ik de bijlage niet verstuurd, dus even de code
in thisworkbook

Option Explicit
Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
  Dim i        As Integer
  Application.EnableEvents = False                         'events tijdelijk uitzetten
  On Error GoTo einde
  MijnPaginaVelden(1) = "Bij welke directie werk je?"      'alle namen van de paginavelden
  MijnPaginaVelden(2) = "Welke afdeling werk je?"
  MijnPaginaVelden(3) = "Welk team werk je?"
  With Sheets(Sh.Name).PivotTables(Target.Name)            'de draaitabel die net veranderd is
    For i = LBound(MijnPaginaVelden) To UBound(MijnPaginaVelden)  'ieder paginaveld bekijken
      MijnKeuzes(i) = Target.PivotFields(MijnPaginaVelden(i)).CurrentPage  'huidige selectie van paginaveld
    Next
  End With
  UpdatenAlleDraaitabellen Sh.Name, Target.Name            'alle andere draaitabellen updaten zoals deze draaitabel
einde:
  Application.EnableEvents = True                          'events terug inschakelen
End Sub

in een gewone module

Option Explicit
Public MijnPaginaVelden(1 To 3) As Variant
Public MijnKeuzes(1 To 3) As Variant

Sub UpdatenAlleDraaitabellen(Werkblad As String, Draaitabel As String)
  Dim Sh As Worksheet, Pt As PivotTable, i As Integer
  For Each Sh In Sheets                                    'elk blad aflopen
    For Each Pt In Sh.PivotTables                          'elke draaitabel aflopen
      If Sh.Name <> Werkblad Or Pt.Name <> Draaitabel Then  'niet de net gewijzigde draaitabel
        For i = LBound(MijnPaginaVelden) To UBound(MijnPaginaVelden)  '1 voor 1 de paginavelden aflopen
          Pt.PivotFields(MijnPaginaVelden(i)).CurrentPage = MijnKeuzes(i)  'keuze gelijk zetten aan gemaakte keuze
        Next
        Pt.Update                                          'dit is nieuw
      End If
    Next Pt
    Cells.EntireColumn.AutoFit                             'kolombreedte op automatisch
  Next
End Sub

Sub eventson()
  Application.EnableEvents = True
End Sub

 

[pinobird]

Fantastisch

Cow18,

Enorm bedankt voor je oplossing! het werkt perfect.

Hans:thumb: