PowerPoint自动执行形状宏：演示启动时批量更新形状状态

我需要在PowerPoint演示文稿的第一张幻灯片中设置多个形状，每个形状对应一张幻灯片。当对应幻灯片包含图片或链接Excel表格时，形状变为绿色；否则变为灰色，以此快速查看各主题幻灯片的内容填充情况。

我已编写宏作为形状的单击动作，演示模式下点击形状可更新颜色，但需手动逐个操作。目标是：打开演示文稿（显示第一张幻灯片）时自动执行所有形状的状态更新逻辑，实现状态自动同步。

我尝试过两种思路但均未成功：

• 编写宏批量触发第一张幻灯片所有形状的单击动作
• 编写代码扫描第一张幻灯片所有形状，获取对应待检查幻灯片的信息并更新颜色

以下是可正常运行的单形状对应幻灯片检查宏代码，请问如何实现进入第一张幻灯片时自动更新所有形状状态？

Sub Shape_Clickfor2(ByVal shp As shape)
    Dim hasImageOrTable As Boolean
    hasImageOrTable = False
    
    '检查幻灯片2是否包含图片或表格
    Dim slideShapes As Shapes
    Set slideShapes = ActivePresentation.Slides(2).Shapes
    Dim shape As shape
    For Each shape In slideShapes
        If shape.Type = msoPicture Or shape.Type = msoEmbeddedOLEObject Then
            hasImageOrTable = True
            Exit For
        End If
    Next shape
    
    '更改形状颜色
    If hasImageOrTable = True Then
        shp.Fill.ForeColor.RGB = RGB(0, 255, 0) '绿色
    Else
        shp.Fill.ForeColor.RGB = RGB(128, 128, 128) '灰色
    End If
End Sub

要实现自动更新，需重构代码并绑定触发事件，步骤如下：

1. 提取通用检查函数 #

将单幻灯片的检查逻辑封装为通用函数，方便复用：

'通用函数：检查指定幻灯片是否包含图片或嵌入OLE对象（如Excel表格）
Function SlideHasContent(targetSlide As Slide) As Boolean
    Dim shp As shape
    For Each shp In targetSlide.Shapes
        '匹配图片或嵌入的Excel表格等OLE对象
        If shp.Type = msoPicture Or shp.Type = msoEmbeddedOLEObject Then
            SlideHasContent = True
            Exit Function
        End If
    Next shp
    SlideHasContent = False
End Function

2. 编写批量更新宏 #

编写批量处理第一张幻灯片所有形状的宏，需提前给形状命名（对应幻灯片编号，比如对应第2张幻灯片的形状命名为Slide2）：

'批量更新第一张幻灯片所有形状的状态
Sub UpdateAllShapeStatus()
    Dim firstSlide As Slide
    Set firstSlide = ActivePresentation.Slides(1)
    
    Dim shp As shape
    For Each shp In firstSlide.Shapes
        '仅处理命名格式为"SlideX"的形状
        If Left(shp.Name, 5) = "Slide" Then
            Dim slideNum As Integer
            '从形状名称中提取对应幻灯片编号
            slideNum = CInt(Mid(shp.Name, 6))
            
            '检查编号对应的幻灯片是否存在
            If slideNum <= ActivePresentation.Slides.Count Then
                '根据检查结果设置形状颜色
                If SlideHasContent(ActivePresentation.Slides(slideNum)) Then
                    shp.Fill.ForeColor.RGB = RGB(0, 255, 0) '绿色
                Else
                    shp.Fill.ForeColor.RGB = RGB(128, 128, 128) '灰色
                End If
            End If
        End If
    Next shp
End Sub

3. 设置自动触发事件 #

打开ThisPresentation模块，添加以下事件代码，实现打开文稿或切换到第一张幻灯片时自动执行更新：

'打开演示文稿时自动更新
Private Sub Presentation_Open()
    UpdateAllShapeStatus
End Sub

'幻灯片放映模式开始时，若当前是第一张则更新
Private Sub Presentation_SlideShowBegin(ByVal Wn As SlideShowWindow)
    If Wn.View.Slide.SlideIndex = 1 Then
        UpdateAllShapeStatus
    End If
End Sub

'普通视图下切换到第一张幻灯片时自动更新
Private Sub Presentation_SlideSelectionChanged(ByVal SldRange As SlideRange)
    If SldRange.SlideIndex = 1 Then
        UpdateAllShapeStatus
    End If
End Sub

操作注意事项 #

• 确保第一张幻灯片的形状命名符合规则：对应第N张幻灯片的形状命名为SlideN
• 打开PowerPoint时需启用宏（在文件选项中设置宏安全级别为"启用所有宏"或"通知我启用宏"）
• 若需保留原单击动作，可将形状的单击事件绑定UpdateAllShapeStatus或单独的检查逻辑

内容的提问来源于stack exchange，提问作者Nico Schmitt