VBA добавляет слайсер в неопределенную таблицу

Question

Я создал макрос, который открывает данные сводной таблицы, которые мне затем нужно использовать для финансовой сверки. Мне нужно go выполнить один и тот же процесс 80 раз, но не в oop, так как мне нужно делать заметки относительно того, что я нашел. Однако работает только первый раз, второй - при добавлении слайсеров таблицы. Я полагаю, что это связано с именем.

При необходимости таблица может быть названа со значением в ячейке D6, однако я понятия не имею, как это сделать, любая помощь будет принята с благодарностью.

ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(ActiveSheet.ListObjects(1).name), "YEAR"). _
Slicers.Add ActiveSheet, , "YEAR", "YEAR", 186, 450.75, 144, 198.75

Или полный код.

Sub FORMAT()

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
    End With

    ActiveCell.Offset(0, 1).COPY
    ActiveCell.Select
    Selection.ShowDetail = True
    RANGE("AF2").Select
    Selection.PasteSpecial Paste:=xlPasteValues

    RANGE("D2").Select

    ActiveSheet.name = ActiveCell.Value

    ActiveSheet.Move After:=Worksheets(Worksheets.Count)

    Columns("B:c").Select
    Selection.Columns.Group

    Columns("H:J").Select
    Selection.Columns.Group

    Columns("L:N").Select
    Selection.Columns.Group

    Columns("T:V").Select
    Selection.Columns.Group

    Columns("K:K").Select
    Selection.NumberFormat = "#,##0.00"

    RANGE("A1").Select

    ActiveSheet.SORT.SortFields.Clear

    ActiveSheet.SORT.SortFields.Add2 Key:=RANGE("Q2:Q1000" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

    ActiveSheet.SORT.SortFields.Add2 Key:=RANGE("R2:r1000" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

    With ActiveSheet.SORT
        .SetRange RANGE("a1:V1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1

    Rows("1:4").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Selection.End(xlDown).Select

    '''''''''''''

    ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(ActiveSheet.ListObjects(1).name), "YEAR"). _
        Slicers.Add ActiveSheet, , "YEAR", "YEAR", 186, 450.75, 144, 198.75

    ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(ActiveSheet.ListObjects(1).name), "QTR"). _
        Slicers.Add ActiveSheet, , "QTR", "QTR", 223.5, 488.25, 144, 198.75

    '''''''''''''

    ActiveSheet.Shapes.RANGE(Array("QTR")).Select
    ActiveSheet.Shapes.RANGE(Array("YEAR")).Select
    ActiveWorkbook.SlicerCaches("Slicer_YEAR").Slicers("YEAR").Left = 0
    ActiveWorkbook.SlicerCaches("Slicer_YEAR").Slicers("YEAR").Top = 0
    ActiveWorkbook.SlicerCaches("Slicer_YEAR").Slicers("YEAR").NumberOfColumns = 8
    ActiveWorkbook.SlicerCaches("Slicer_YEAR").Slicers("YEAR").ColumnWidth = 35.43
    ActiveSheet.Shapes("YEAR").Height = 56.69
    ActiveSheet.Shapes("YEAR").Width = 311.81

    ActiveSheet.Shapes.RANGE(Array("QTR")).Select
    ActiveWorkbook.SlicerCaches("Slicer_QTR").Slicers("QTR").Left = 316.06
        ActiveWorkbook.SlicerCaches("Slicer_QTR").Slicers("QTR").Top = 0
    ActiveWorkbook.SlicerCaches("Slicer_QTR").Slicers("QTR").NumberOfColumns = 4
    ActiveWorkbook.SlicerCaches("Slicer_QTR").Slicers("QTR").ColumnWidth = 35.43
    ActiveSheet.Shapes("QTR").Height = 56.69
    ActiveSheet.Shapes("QTR").Width = 161.57
    RANGE("a5").Select
    ```

Answer 1

Я нашел на это простой ответ. Буквально просто заменив первый "ГОД" на "Activesheet.name"

'ORIGINAL'
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(1), "YEAR"). _
Slicers.Add ActiveSheet, , "YEAR", "YEAR", 186, 450.75, 144, 198.75

'FINAL'
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(1), "YEAR"). _
Slicers.Add ActiveSheet, , ActiveSheet.Name , "YEAR", 186, 450.75, 144, 198.75

Answer 2

SlicerCaches.Add2 возвращает объект SlicerCache, поэтому вы можете записать его и использовать ссылку по мере необходимости. Точно так же Slicers.Add дает вам ссылку Slicer, которую вы можете использовать напрямую, не зная ее имени:

Dim wb As Workbook, ws As Worksheet, scYear As SlicerCache, scQtr As SlicerCache
Dim slcYear As Slicer, slcQtr As Slicer

Set ws = ActiveSheet
Set wb = ws.Parent   'workbook with the activesheet

'...
'...

'create caches and slicers
Set scYear = wb.SlicerCaches.Add2(ws.ListObjects(1), "YEAR")
Set slcYear = scYear.Slicers.Add(ws, , "YEAR", "YEAR", 186, 450.75, 144, 198.75)

Set scQtr = wb.SlicerCaches.Add2(ws.ListObjects(1), "QTR")
Set slcQtr = scQtr.Slicers.Add(ws, , "QTR", "QTR", 223.5, 488.25, 144, 198.75)

'''''''''''''

With slcYear
    .Left = 0
    .Top = 0
    .NumberOfColumns = 8
    .ColumnWidth = 35.43
    .Height = 56.69
    .Width = 311.81
End With

With slcQtr
    .Left = 316.06
    .Top = 0
    .NumberOfColumns = 4
    .ColumnWidth = 35.43
    .Height = 56.69
    .Width = 161.57
End With