none
slicer items to pdf RRS feed

  • Question

  • Hi 
    I have big excel file that i want to export all the items out of a slicer to pdf. i have manage to get the code to go through all items of the slicer but no output no pdf is not been created. 
    The purpose is to generate a pdf ofr each slider items being printed automaticly it is asoemthing around 130 tiems in the slicer. 

    Sub LoopSlicer() Dim intSliceCount As Integer
     Dim intLoop As Integer
     Dim sliceLoop As Integer
     Dim slice As SlicerItem
     Dim arrayone() As String
     
     Dim mySlicer As SlicerCache
     Set mySlicer = ActiveWorkbook.SlicerCaches("Slicer_Cost_Center")
    
    
     intSliceCount = 0
    
    
     'Count slicer options
     For Each slice In mySlicer.SlicerItems
    intSliceCount = intSliceCount + 1
     Next slice
    
    
    'NOTE:------------------------------------
     'When selecting a slicer, all other slicers
     'in the field must be de-selected
     '-----------------------------------------
    
    
     'Activate slicers one by one, and print
     With mySlicer
    For intLoop = 1 To intSliceCount
    
    
        'Activate the current slicer in loop, deactivate rest
        For sliceLoop = 1 To intSliceCount
            If intLoop = sliceLoop Then
                .SlicerItems(intLoop).Selected = True
            Else
                .SlicerItems(sliceLoop).Selected = False
            End If
        Next sliceLoop
    
    
        Application.DisplayAlerts = False
    
    
        ' Check for year folder and create if needed
    
    
        If Len(Dir("H:\" & Year(Date), vbDirectory)) = 0 Then
            MkDir "H:\" & Year(Date)
        End If
    
    
        ' Check for month folder and create if needed
    
    
        If Len(Dir("H:\" & Year(Date) & "\" & Format(Date, "mm", False), vbDirectory)) = 0 Then
            MkDir "H:\" & Year(Date) & "\" & Format(Date, "mm", False)
        End If
    
    
        ' Converts to PDF and saves with YYYY MM and the file name to be what is listed as
        ' the NamedRange(in this case StarWars listed on any sheet when you define Customer Name to that)
       
        'arrayone = ActiveWorkbook.Sheets(Array("Sheet5")).Select
        Sheets("Sheet5").Activate
        ActiveWorkbook.Sheets(Array("Cost center report")).Select
        'ActiveWorkbook.ActiveSheets(Array("Cost enter report")).Select
        'ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF Quality:=xlQualityStandard
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF
         
         
        'ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "/" & Filename & ".pdf", , , False & .SlicerItems(intLoop).Name
        Filename = "H:\" & Year(Date) & "\" & Format(Date, "mm", False) & "\" & Format(Date, "yyyy_mm_") & .SlicerItems(intLoop).Name
        
        Quality = xlQualityStandard
        IncludeDocProperties = True
        IgnorePrintAreas = False
        OpenAfterPublish = False
        Application.DisplayAlerts = True
    
    
        ' Popup Message that the conversion and save is complete
    
    
       ' MsgBox "File Saved As:" & vbNewLine & "C:\" & Year(Date) & "\" & Format(Date, "mm", False) & "\" & _
        '        Format(Date, "yyyy_mm_") & Range("C").Value & " - " & .SlicerItems(intLoop).Name
    
    
        'De-activate the current slicer in loop, activate rest
        For sliceLoop = 1 To intSliceCount
            If intLoop = sliceLoop Then
                .SlicerItems(intLoop).Selected = False
            Else
                .SlicerItems(sliceLoop).Selected = True
            End If
        Next sliceLoop
    
    
     Next intLoop
     End With
    
    
     End Sub


    • Edited by magnus46 Thursday, July 28, 2016 8:16 AM
    Thursday, July 28, 2016 8:15 AM