PPT VBA how to select all certain shape type?

I want change all rectangles in PPT with certain type(black edge and filled with red) into (pink edge filled with blue).

I suppose there two steps: (1) Use VBA to select all of certain types
(2) back in PPT then change all edge and filling color, just the same as change one rectangle. If you want to change all certain rectangle you just need to choose all first and then manipulate them. that's my opinion.

I use the following code but it doesn't work.

Sub my()
Dim currentSlide As Slide
Dim shp As Shape
Dim sld As Slide

For Each currentSlide In ActivePresentation.Slides
Set sld = Application.ActiveWindow.View.Slide
For Each shp In currentSlide.Shapes
If shp.Type = 1 Then 
shp.Select 
End If
Next shp
Next currentSlide
End Sub

No reason to collect all shapes in an array or select them.

Simply loop over all shapes, check if you want to modify it (check type and maybe fill and line color) and if yes, modify it:

Sub my()
    Dim sld As Slide
    Dim shp As Shape
    
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            With shp
                If .Type = msoShapeRectangle Then
                    ' You can check the current colors if needed, 
                    ' just enable the following IF and adapt the colors
                    ' If .Fill.ForeColor = vbRed And .Line.ForeColor = vbBlack Then
                        .Fill.ForeColor.RGB = RGB(0, 0, 255)     
                        .Line.ForeColor.RGB = RGB(255, 128, 255)
                    ' End If
                End If
            End With
        Next shp
    Next sld
End Sub

Your code is looping through the shapes and selecting them (I have not tested it, but that's what it's supposed to do anyway) without any action. The below code:

• creates an array of slides and call a function that
• creates two arrays, one of shapes and of long, the first being only an intermediate one
  color the fill of those shapes in the range of the matching ones in blue

you may want to:

• edit the content of the If and add the line.forecolor value
• process further the shapes individually where marked for those actions that cannot be done collectively

Sub processShapes(sL As PowerPoint.Slide)

Dim shArr() As Shape
Dim sH As Shape
Dim aLLsHArr() As Long
Dim indexArr() As Long
Dim sHIndex As Long

Dim z As Long

ReDim shArr(1 To sL.Shapes.Count)

    For z = LBound(shArr) To UBound(shArr)
        Set shArr(z) = sL.Shapes(z)
        Set sH = shArr(z) ' do things indivually here to the shape
    
            If sH.AutoShapeType = msoShapeRectangle Then
'           If sH.Type =msoPicture then 'or something else
             'You can of course do sH.Fill.Forecolor.RGB = 12874308 here as well 
            sHIndex = sHIndex + 1
            ReDim Preserve indexArr(1 To sHIndex)
            indexArr(sHIndex) = z
            
            
            End If
    Next z
    
sL.Shapes.Range(indexArr).Fill.ForeColor.RGB = 12874308

'but by using this method you can also do things like this 


'sL.Shapes.Range(indexArr).Group


'to the "match" as it is being intended here as a whole, 
'not just as individual rectangles/whatever_shape


End Sub




Sub processSlides()

Dim sldArr() As Slide
Dim j As Long
    
  

    ReDim sldArr(1 to ActivePresentation.Slides.Count)
    
        For j = LBound(sldArr) To UBound(sldArr) 'I checked and there were no errors 
                Call processShapes(ActivePresentation.Slides(j))
        Next j

End Sub

Update

A collection can be used instead of the array to be resized each time (a non-efficient way to use arrays), I have been using the code I gave above for many hundreds of shapes without issues, however the linked article made me rethink the answer. The below is tested and works. The thing is that passing the Collection as range to do things collectively gives error, so the array of long has to be created anyway...

Sub coLLectShapes()
Dim sL As Slide: Set sL = ActivePresentation.Slides(2)
Dim shArr() As Shape
Dim sH As Shape
Dim aLLsHArr() As Long
Dim indexArr() As Long
Dim sHIndex As Long

Dim sHpsToGrab As Collection: Set sHpsToGrab = New Collection

Dim z As Long

ReDim shArr(1 To sL.Shapes.Count)

    For z = LBound(shArr) To UBound(shArr)
        Set shArr(z) = sL.Shapes(z)
         Set sH = shArr(z) ' do things indivually here to the shape

            If sH.AutoShapeType = msoShapeRectangle Then           
             sHpsToGrab.Add z
            
            End If
    Next z

    Erase shArr 'and free the memory

    Dim coLLToArr() As Long: ReDim coLLToArr(1 To sHpsToGrab.Count)
    Dim k As Long
    For k = 1 To sHpsToGrab.Count
     coLLToArr(k) = sHpsToGrab.Item(k)
    Next k
    
'sL.Shapes.Range(coLLToArr).Group
sL.Shapes.Range(coLLToArr).Fill.ForeColor.RGB = 12874308

End Sub