Sub Test() Dim s As Shape Dim n As Long ActiveDocument.SaveSettings ActiveDocument.PreserveSelection = False n = 0 For Each s In ActivePage.Shapes If s.Type = cdrBitmapShape Then n = n + 1 Next s ActiveDocument.RestoreSettings MsgBox "There are " & n & " bitmaps in the current drawing" End Sub