Excel VBA遍历Slicer切片器逐项目保存文件时循环失效问题

核心报错原因 #

你代码的核心问题出在SaveAs操作：执行ActiveWorkbook.SaveAs后，当前激活的工作簿会变成新保存的副本，原本定义的slBox切片器缓存对象在新文件中不存在，后续循环遍历SlicerItems时就会抛出异常。其次也可能存在切片器缓存名称不匹配、存储路径无效的问题。

修正后的完整代码 #

Option Explicit

Sub SavingData()
    Dim Folder As Workbook
    Dim NewFolderName As String
    Dim ReportFolder As String
    Dim slItem As SlicerItem
    Dim slDummy As SlicerItem
    Dim slBox As SlicerCache
    ' 新增：提前存储所有切片器项名称，避免对象变动导致遍历失败
    Dim itemNames() As String
    Dim i As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set Folder = ActiveWorkbook
    ' 执行前请确认此处切片器缓存名称和实际名称完全一致
    Set slBox = Folder.SlicerCaches("Slicer_Regroupement_SousR")
    ReportFolder = Folder.Sheets("Variables").Range("FileName").Value
    
    ' 新增：判断路径是否存在，不存在则自动创建
    If Dir(ReportFolder, vbDirectory) = "" Then
        MkDir ReportFolder
    End If
    
    ' 提前把所有切片器项名称存入数组
    ReDim itemNames(1 To slBox.SlicerItems.Count)
    For i = 1 To slBox.SlicerItems.Count
        itemNames(i) = slBox.SlicerItems(i).Name
    Next i
    
    ' 遍历数组内的项名称，避免直接遍历可能变动的SlicerItems集合
    For i = LBound(itemNames) To UBound(itemNames)
        slBox.ClearManualFilter
        ' 仅选中当前遍历的项
        For Each slDummy In slBox.SlicerItems
            slDummy.Selected = (slDummy.Name = itemNames(i))
        Next slDummy
        
        NewFolderName = Folder.Sheets("Variables").Range("ReportName").Value
        ' 用SaveCopyAs替代SaveAs，不改变当前工作簿对象，避免原有引用失效
        Folder.SaveCopyAs Filename:=ReportFolder & "\" & NewFolderName & ".xlsx"
    Next i
    
    ' 重置切片器筛选，恢复原文件状态
    slBox.ClearManualFilter
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

关键优化点 #

• 提前将切片器所有项的名称存入数组，避免循环过程中对象变动导致遍历异常
• 用SaveCopyAs代替SaveAs，不会切换当前激活的工作簿，原有对象引用不会失效
• 增加了存储路径有效性判断，避免路径不存在导致的报错
• 循环结束后自动重置切片器筛选，不影响原文件使用状态

内容的提问来源于stack exchange，提问作者Hitan Patel