查找具有特定 Tags.Value 的所有幻灯片并将其删除答案

【问题标题】：Find all slides with a specific Tags.Value and delete them查找具有特定 Tags.Value 的所有幻灯片并将其删除
【发布时间】：2022-11-01 10:51:07
【问题描述】：

VBA 新手。我有一个包含 150 多张幻灯片的大型 PPT，并且我运行了一个 VBA 宏将它们（SlidesA ... SlidesF）标记为标签“分组”。我有一个带有一堆复选框的用户表单来选择用户想要保留的幻灯片分组。在选择了用户想要保留的分组后，他们单击“确定”按钮。我有一些代码（如下）来查找未选中的幻灯片并根据 Tags.Value 将其删除，并保留其余部分。但由于某种原因，它并没有删除所有幻灯片，它只是删除了 SlidesA 组中的 4 个。

Private Sub btnOK_Click()

' Slide.Tag has .Name and .Value parameters

If chkSlidesA = False Then
    For Each s In Application.ActivePresentation.Slides
    With s.Tags
        For i = 1 To .Count
            If .Value(i) = "SlidesA" Then
            s.Delete
            End If
        Next i
    End With
    Next
Else

If chkSlidesB = False Then
    For Each s In Application.ActivePresentation.Slides
    With s.Tags
        For i = 1 To .Count
            If .Value(i) = "SlidesB" Then
            s.Delete
            End If
        Next i
    End With
    Next
Else

If chkSlidesC = False Then
    For Each s In Application.ActivePresentation.Slides
    With s.Tags
        For i = 1 To .Count
            If .Value(i) = "SlidesC" Then
            s.Delete
            End If
        Next i
    End With
    Next
Else

If chkSlidesD = False Then
    For Each s In Application.ActivePresentation.Slides
    With s.Tags
        For i = 1 To .Count
            If .Value(i) = "SlidesD" Then
            s.Delete
            End If
        Next i
    End With
    Next
Else

If chkSlidesE = False Then
    For Each s In Application.ActivePresentation.Slides
    With s.Tags
        For i = 1 To .Count
            If .Value(i) = "SlidesE" Then
            s.Delete
            End If
        Next i
    End With
    Next
Else

If chkSlidesF = False Then
    For Each s In Application.ActivePresentation.Slides
    With s.Tags
        For i = 1 To .Count
            If .Value(i) = "SlidesF" Then
            s.Delete
            End If
        Next i
    End With
    Next
Else

End If
End If
End If
End If
End If
End If

Unload Me

End Sub

我已经通过运行一些 VBA 来读取标签并显示一个 MsgBox 来显示标签值，从而验证了幻灯片是否标记有正确的值。

我试图理解为什么它没有删除所有幻灯片。

【问题讨论】：

尝试颠倒幻灯片遍历/删除的顺序
从集合中删除项目时，您犯了经典的新手错误。当您删除第 2 项时，第 3 项自动变为第 2 项。但 VBA 管理的控件变量不知道这一点并递增到 3，但第 3 项现在是第 4 项，因此您跳过了一项。您可以安全地从集合中删除的唯一方法是反向迭代集合。这意味着您不能执行 For Each，您必须使用 Count -1 到 1 执行 for Next。
是的，我最初的想法是删除部分，我注意到它正在执行整个“3 变为 2”，并且在迭代时删除了错误的部分 ID……我没有想到它正在这样做这里也是。谢谢！

标签： vba powerpoint

【解决方案1】：

@freeflow 的 + 我的评论翻译成代码

Private Sub btnOK_Click()
    Dim concatSlidesAF As String
    concatSlidesAF = IIf(chkSlidesA, "A", "") & IIf(chkSlidesB, "B", "") & _
                     IIf(chkSlidesC, "C", "") & IIf(chkSlidesD, "D", "") & _
                     IIf(chkSlidesE, "E", "") & IIf(chkSlidesF, "F", "")
    
    If Len(concatSlidesAF) = 0 Then
        GoTo ES
    Else
        concatSlidesAF = "Slides[" & concatSlidesAF & "]"
    End If
    
    Dim i As Long, j As Long
    With Application.ActivePresentation.Slides
        For i = .Count To 1 Step -1
            With .Item(i)
                For j = 1 To .Tags.Count
                    If .Tags.Value(j) Like concatSlidesAF Then
                        .Delete
                        Exit For
                    End If
                Next j
            End With
        Next i
    End With
ES:
    Unload Me
End Sub

我使用concatSlidesAF 只是为了稍微压缩一下代码。

【讨论】：

我已经尝试过这段代码，但它对我不起作用。问题：在您的示例中，您有：IIf(chkSlidesA, "A", "")。用双引号括起来的两个字符串表示什么？那是标签名称和标签值参数吗？我正在尝试匹配标签.Value。我尝试将标签值移动到第二组双引号，但它仍然不起作用。
IIf (chkSlidesA, "A", "") 表示如果chkSlidesA 是TRUE 返回字符串A，否则返回空字符串。这用于检查标签值。尝试做IIf (chkSlidesA.value <> False, "A", "")。例如，如果您选择了 chkSlidesA 和 chkSlidesB 复选框，则 concatSlidesAF 将等于 Slides[AB]，并且在 like 语句中使用。
使用 Like 的示例："SlidesD" Like "Slides[ABCD]" 是 True 但 "SlidesF" Like "Slides[ABCD]" 是 False。我希望现在使用 IIF 的意图很明确。
好的，我知道为什么这对我不起作用。我不得不将“A”、“B”等移动到 FALSE 部分，如下所示：concatSlidesAF = IIf(chkSlidesA, "", "A") 因为我想在未选中 chkSlidesA 时触发（即用户不想要这些幻灯片，所以删除它们）。我还使用了不同的标签名称，并且在 Like 运算符匹配方面遇到了问题，所以我可以让它工作的唯一方法是实际使用这些标签名称（SlidesA、SlidesB 等）。但它有效。

【解决方案2】：

所以其他人可以看到对我有用的修改后的解决方案，这是我的代码的最终工作版本：

Private Sub btnOK_Click()
    Dim concatSlidesAF As String
    concatSlidesAF = IIf(chkSlidesA, "", "A") & IIf(chkSlidesB, "", "B" & _
                     IIf(chkSlidesC, "", "C") & IIf(chkSlidesD, "", "D") & _
                     IIf(chkSlidesE, "", "E") & IIf(chkSlidesF, "", "F")
    
    If Len(concatSlidesAF) = 0 Then
        GoTo ES
    Else
        concatSlidesAF = "Slides[" & concatSlidesAF & "]"
    End If
    
    Dim i As Long, j As Long
    With Application.ActivePresentation.Slides
        For i = .Count To 1 Step -1
            With .Item(i)
                For j = 1 To .Tags.Count
                    If .Tags.Value(j) Like concatSlidesAF Then
                        .Delete
                        Exit For
                    End If
                Next j
            End With
        Next i
    End With

Call DeleteEmptySections

ES:
    Unload Me
End Sub

我还包括一个 Sub 来查找和删除不再包含任何幻灯片的任何部分：

Sub DeleteEmptySections()
    Dim lSP As Long
    With ActivePresentation.SectionProperties
        For lSP = .Count To 1 Step -1
            If .SlidesCount(lSP) = 0 Then .Delete lSP, True
        Next
    End With
End Sub

【讨论】：