Sub Test() Dim s As Shape, n As Long n = 0 For Each s In ActivePage.Shapes If s.Type = cdrBitmapShape Then If s.Bitmap.Transparent Then n = n + 1 End If Next s MsgBox "There are " & n & " transparent bitmaps" End Sub