Sub CountObjects()
Dim Rng As Range, i As Long, j As Long
With ActiveDocument
  For Each Rng In .StoryRanges
    On Error Resume Next
    With Rng
      i = i + .InlineShapes.Count
      j = j + .ShapeRange.Count
    End With
  Next Rng
  MsgBox "The active document contains:" & vbCr & _
    i & " inline shapes & " & j & " floating shapes."
End With
End Sub