I've followed instructions on this thread : https://www.mrexcel.com/forum/excel-questions/982591-slicer.html,
But it only works on a standalone pivot table, not one connected to an OLAP cube.
Is there any way to generate Pdf files of a pivot table that's connected to an OLAP cube, based on each slicer items ?
Thank you!
Here's the code written by @Domenic, for reference.
Option Explicit
Sub CreatePDFForEachSlicerItem()
Const sSlicerName As String = "Region" 'change the slicer name accordingly
Dim sDestFolder As String
Dim Idx As Long
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
On Error GoTo ErrHandler
sDestFolder = "C:\Users\Domenic\Desktop" 'change the path accordingly
If Len(Dir(sDestFolder, vbDirectory)) = 0 Then
MsgBox sDestFolder & " does not exist.", vbInformation
GoTo ExitTheSub
End If
If Right(sDestFolder, 1) <> "" Then
sDestFolder = sDestFolder & ""
End If
With ActiveWorkbook.SlicerCaches("Slicer_" & sSlicerName)
.ClearManualFilter
With .SlicerItems
For Idx = 1 To .Count
If Idx > 1 Then
.Item(Idx).Selected = False
End If
Next Idx
For Idx = 1 To .Count
ActiveSheet.ExportAsFixedFormat xlTypePDF, sDestFolder & .Item(Idx).Caption & ".pdf"
If Idx < .Count Then
.Item(Idx + 1).Selected = True
.Item(Idx).Selected = False
End If
Next Idx
End With
.ClearManualFilter
End With
MsgBox "Completed...", vbInformation
ExitTheSub:
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Exit Sub
ErrHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error"
Resume ExitTheSub
End Sub
But it only works on a standalone pivot table, not one connected to an OLAP cube.
Is there any way to generate Pdf files of a pivot table that's connected to an OLAP cube, based on each slicer items ?
Thank you!
Here's the code written by @Domenic, for reference.
Option Explicit
Sub CreatePDFForEachSlicerItem()
Const sSlicerName As String = "Region" 'change the slicer name accordingly
Dim sDestFolder As String
Dim Idx As Long
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
On Error GoTo ErrHandler
sDestFolder = "C:\Users\Domenic\Desktop" 'change the path accordingly
If Len(Dir(sDestFolder, vbDirectory)) = 0 Then
MsgBox sDestFolder & " does not exist.", vbInformation
GoTo ExitTheSub
End If
If Right(sDestFolder, 1) <> "" Then
sDestFolder = sDestFolder & ""
End If
With ActiveWorkbook.SlicerCaches("Slicer_" & sSlicerName)
.ClearManualFilter
With .SlicerItems
For Idx = 1 To .Count
If Idx > 1 Then
.Item(Idx).Selected = False
End If
Next Idx
For Idx = 1 To .Count
ActiveSheet.ExportAsFixedFormat xlTypePDF, sDestFolder & .Item(Idx).Caption & ".pdf"
If Idx < .Count Then
.Item(Idx + 1).Selected = True
.Item(Idx).Selected = False
End If
Next Idx
End With
.ClearManualFilter
End With
MsgBox "Completed...", vbInformation
ExitTheSub:
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Exit Sub
ErrHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error"
Resume ExitTheSub
End Sub