Try:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument
For i = .InlineShapes.Count To 1 Step -1
With .InlineShapes(i)
.Range.InsertBefore "Picture " & i
.Delete
End With
Next
End With
Application.ScreenUpdating = True
End Sub