Click all shapes on a slide automatically / Run multiple macros at beginning of presentation

Question

I want multiple shapes on the first slide of a PowerPoint presentation, that turn either green or grey depending on whether there is a picture or linked Excel table on a specific slide. Basically one shape referring to one slide of the presentation, so that when looking at the first slide, you see which topics (slides) have been filled with information (i.e. pictures or linked tables).

I created a macro that can be put behind a shape on the first slide as an on-click action, which changes its colour to either green or grey when clicking on the shape in presentation mode. This works with multiple shapes referring to a different slide each, but each shape has to be clicked manually to update (green/grey).

The goal is that when opening the presentation (first slide is shown) all macros behind the shapes are executed automatically to see the current situation displayed on the first slide.

One way I can imagine is to have a macro set behind a neutral shape on the first slide, so that when this one is clicked a macro is executed, which executes all the macros that are put behind the other shapes and change their color accordingly. I couldn't write code that clicks every shape on the first slide once.

Another approach would be to have one code, that scans all shapes on the first slide, gets the information on which slide should be checked for pictures/tables to change its color, and then change the color. I wasn't successfull.

Here is the working code to change the color depending on the information (pictures/tables) on a specific slide. How can I automate the clicking or updating the states when entering the first slide?

Sub Shape_Clickfor2(ByVal shp As shape)
    Dim hasImageOrTable As Boolean
    hasImageOrTable = False
    
    'Überprüfen, ob auf Folie 2 ein Bild oder eine Tabelle vorhanden ist
    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
    
    'Farbe der Form ändern
    If hasImageOrTable = True Then
        shp.Fill.ForeColor.RGB = RGB(0, 255, 0) 'grün
    Else
        shp.Fill.ForeColor.RGB = RGB(128, 128, 128) 'grau
    End If
End Sub

Answer 1

You could loop over all the slides in the presentation (excluding the first) and update the fill for named shapes ("slide_2", "slide_3", etc) on the first slide

Sub Shape_Clickfor2(ByVal shp As shape)
    
    Dim hasImageOrTable As Boolean, sld As Slide, shape As shape
    hasImageOrTable = False
    
    For Each sld In ActivePresentation.Slides  'loop all slides
        If sld.SlideIndex > 1 Then             'skip slide 1 
            hasImageOrTable = False            'reset flag
            For Each shape In sld.Shapes
                If shape.Type = msoPicture Or shape.Type = msoEmbeddedOLEObject Then
                    hasImageOrTable = True
                    Exit For
                End If
            Next shape
            'update color for named shape on slide 1 based on flag value
            With ActivePresentation.Slides(1).Shapes("slide_" & sld.SlideIndex)
                .Fill.ForeColor.RGB = IIf(hasImageOrTable, _
                                          RGB(0, 255, 0), _
                                          RGB(128, 128, 128))
            End With
        End If 'not slide 1
    Next sld
End Sub

Here's a version using the SlideID:

Sub Shape_Clickfor2(ByVal shp As shape)
    
    Dim hasImageOrTable As Boolean, sld As Slide, shape As shape, id, obj As shape
    hasImageOrTable = False
    
    For Each sld In ActivePresentation.Slides  'loop all slides
        
        Set shape = Nothing
        On Error Resume Next  'ignore error if no match
        'is there a shape for this slide's ID?
        Set shape = ActivePresentation.Slides(1).Shapes("slide_" & sld.SlideID)
        On Error GoTo 0       'stop ignoring errors
        
        If Not shape Is Nothing Then           'got a shape?
            
            hasImageOrTable = False            'reset flag
            
            For Each obj In sld.Shapes
                If obj.Type = msoPicture Or obj.Type = msoEmbeddedOLEObject Then
                    hasImageOrTable = True
                    Exit For
                End If
            Next obj
            
            shape.Fill.ForeColor.RGB = IIf(hasImageOrTable, _
                                          RGB(0, 255, 0), _
                                          RGB(128, 128, 128))
        End If
    Next sld
    
End Sub