Option Explicit
Sub CreatePDFForEachSlicerItem()
Const sSlicerName As String = "Region" [COLOR=#008000]'change the slicer name accordingly[/COLOR]
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\" [COLOR=#008000]'change the path accordingly[/COLOR]
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