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.Cropped Then n = n + 1 End If Next s MsgBox "There are " & n & " bitmaps which can be cropped." End Sub