Я пытаюсь распечатать отчеты для выбранных держателей бюджета (выбранных из таблицы держателей бюджета), используя имя держателя бюджета для ввода в слайсер, который затем обновляет различные сводные таблицы. Проблема в том, что код выбирает всех держателей бюджета в слайсере, а не выбирает одного выбранного держателя бюджета, который я выбираю из таблицы.
Sub PrintPDFsSO()
Dim Lobj As ListObject
Dim Budholder As String
Dim Path As String
Dim x As Long, y As Long, Number_of_rows As Long
Dim SourceBk As Workbook
Dim SlicItem As SlicerItem, SlicDummy As SlicerItem, SlicCache As SlicerCache
Dim pt As PivotTable, wb As Workbook, ws As Worksheet
Set SourceBk = ThisWorkbook
Set Lobj = SourceBk.Sheets("BudHolders").ListObjects("BudHolderList")
Set SlicCache = SourceBk.SlicerCaches("Slicer_Budget_Holder")
For x = 1 To Lobj.DataBodyRange.Rows.Count 'Budget Holders held in BudHolderList Table
Dim BudHolders()
ReDim BudHolders(1 To Lobj.DataBodyRange.Rows.Count) 'as Budholders will only ever hold one budget hodler name, can this be simpified?
Dim Counter As Long
Counter = 1
If Not Lobj.DataBodyRange.Rows(x).EntireRow.Hidden Then
Budholder = Lobj.DataBodyRange(x, 3) 'Name of budget holder held in 3rd column of Budget Holder Table
BudHolders(Counter) = Budholder 'Budholders holds the budget holder name
Counter = Counter + 1
ReDim Preserve BudHolders(1 To Counter - 1)
' Trying to stop slicers/pivot tables calculating so code setting new filter on budget name doesnt get stuck - but not working
Application.Calculation = xlCalculationManual
For Each ws In SourceBk.Sheets
For Each pt In ws.PivotTables
pt.ManualUpdate = True
Next pt
Next ws
'Code to change budget holder in slicer to next budget holder in selection from Table
For y = LBound(BudHolders) To UBound(BudHolders)
With SlicCache
.ClearManualFilter 'clears all filters and shows all items in budget holder slicer
For Each SlicItem In .SlicerItems
If BudHolders(y) <> SlicItem.Value Then 'Tests if the slicer item matches the current a value of budholder
SlicItem.Selected = False 'Grinding to a virtual halt on this line as it 'calculates and populates pivot table report'
End If
Next SlicItem
End With
Next y
Application.Calculation = xlCalculationAutomatic
For Each ws In SourceBk.Sheets
For Each pt In ws.PivotTables
pt.ManualUpdate = False
Next pt
Next ws
'Use budholder name which will populate some graphs etc in workbook with new figures
SourceBk.Sheets("Graphs - Summary").Range("BudHolder_SG").Value = Budholder
'Do Printing, saving etc
End If
Next
End Sub