Help with a macro for converting all objects to bitmaps through all pages

Hello everyone!

Could anyone help me with this macro?

Sub Macro2()
    Dim p As Page, s As Shape, sr As ShapeRange
    Dim i&
    For i = 1 To ActiveDocument.Pages.Count
        ActiveDocument.Pages(i).Shapes.All.ConvertToBitmapEx 5, False, False, 150, 1, True, False, 95
    Next i
End Sub

I modified this macro from Sub GDG_John( ) in order to convert all objects of each page into a single bitmap, but it keeps deleting all objects except those in the active page.

Thank you in advance!