loop door slicer - maak een pdf van elk sliceritem

Status
Niet open voor verdere reacties.

sandra1978

Gebruiker
Lid geworden
21 feb 2011
Berichten
64
Hallo,

Ik heb een draaitabel (tabblad "per persoon"), waarbij ik van elk sliceritem "lesgever naam" een pdf wil opslaan. De code is hoofdzakelijk gebaseerd op wat ik op 't net gevonden heb. Er wordt effectief iets opgeslagen, maar:
- lay-out ziet er anders uit
- ik krijg een som ipv een gemiddelde te zien
- een absoluut getal ipv een percentage
Ik wil gewoon dat t eruit ziet, zoals in de huidige draaitabel opgemaakt.

Ik heb t ook al eens met de rapportfilter geprobeerd, ipv de slicer, maar dat gaf dan weer andere problemen. Kan iemand me helpen?
Het document is heel groot, dus online opgeslagen https://1drv.ms/x/s!AsIc6FiZ_zTXkiM1p1Wxbzxzk2w7?e=SdpCzb
De output die ik kreeg, en er dus niet uitziet zoals gewenst, vind je in de bijlage

Hier is de code:
Code:
Sub McrCodeOranjePerLesgever()
    
 
    Dim pt As PivotTable
    Dim sC As SlicerCache
    Dim sI As SlicerItem, siDummy As SlicerItem
    Dim co As ChartObject
    Dim wsBlank As Worksheet
    Set wsBlank = ActiveWorkbook.Sheets.Add
    
    With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .DisplayAlerts = False
    
         
     MsgBox "De bestanden worden gesaved in " & Application.DefaultFilePath 'laten weten aan user waar de bestanden opgeslagen worden (is nu de standdarddlocatie, kan later aangepast worden naar map op o-schijf of sharepoint
     Set perpersoon = Worksheets("per persoon")
     Worksheets("per persoon").Activate
  
  
Set sC = ActiveWorkbook.SlicerCaches("Slicer_lesgever_naam")
Set pt = sC.PivotTables(1)
         
  For Each sI In sC.SlicerItems
        sC.ClearManualFilter
        For Each siDummy In sC.SlicerItems
            siDummy.Selected = (sI.Name = siDummy.Name)
        Next siDummy

        ' now only 1 sliceritem is selected and can be used
          
        With pt.TableRange1
        .CopyPicture Appearance:=xlScreen, Format:=xlPicture
          Set co = wsBlank.ChartObjects.Add(1, 1, .Width, .Height)
          co.Select
          co.Chart.Paste
          co.Chart.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Application.DefaultFilePath & "\" & Left(sI.Name, InStrRev(ActiveWorkbook.Name, ".")) & "pdf", _
          Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
          co.Delete
        End With
    Next sI
 
End With

End Sub
 

Bijlagen

  • Alex Meynenpdf.pdf
    126,2 KB · Weergaven: 20
Laatst bewerkt:
Als het bestand te groot is dan kan je toch een representatief voorbeeld plaatsen?
 
er zijn teveel tabbladen met elkaar gelinkt, waardoor het me net iets gemakkelijker leek om t zo te doen. Ik wou eerst enorm veel rijen wissen, en tot 3x toe mijn Excel gecrashed...dus vandaar online gezet.
 
Waar ie niet geopend of gedownload kan worden. Gebruik Wetransfer.
 
ok peoples,
het is me ondertussen gelukt.
Ik heb t via deze code kunnen doen na lang zoeken op t internet.
Code:
'This VBA will loop through your Power Pivot slicer and print the results to PDF.
'To get it working change slicer name and storage location in below VBA.

Private Sub PowerPivotLoopSlicerPrintPDF()
Dim SC As SlicerCache
Dim SL As SlicerCacheLevel
Dim SI As SlicerItem

Set SC = ActiveWorkbook.SlicerCaches("Slicer_lesgever_naam") 'Add slicer name between " "
Set SL = SC.SlicerCacheLevels(1)

'c(ounter) is set to 1, ready to begin
c = 1


'Repeat the a loop until number of prints exceeds number of items in slicer
Do While c <= SC.SlicerCacheLevels.Item.Count + 1

'This makes sure that SI is the correct slicer. Needed for corrent file name.
    For Each SI In SL.SlicerItems
        If SI.Selected = True Then
        SlicerverdiIndex = c
    Exit For
        End If
    Next SI


    'PRINT CODE
    Dim FName           As String
    Dim FPath           As String

    'Define file path for printed file storage
    FPath = Application.DefaultFilePath   'Choose your filepath
    FName = SI.SourceName

    'Define WHAT to print and how to build file name
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    FPath & "\" & FName & ".pdf", Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    False

    'PRINT CODE FINISHED

'Sets the slicer to the last item in the list
If SlicerverdiIndex = 1 Then
    SlicerverdiIndex = SC.SlicerCacheLevels.Item.Count + 1
End If
SC.VisibleSlicerItemsList = SL.SlicerItems(SlicerverdiIndex - 1).Name

'Adds 1 to the counter, will loop until end of slicer has been reached.
c = c + 1

Loop

End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan