page numbering macro causes crash...

Hi.  I have this code and it runs okay as long as I don't have too many pages with graphics on them.  I can re-create the crash many times and would like to know if there is something else I can add to this so that the crash does not happen.  Maybe something that will check when the page deletion process is taking longer than normal and the macro will pause to allow processing?

Dim s As Shape

    For Each pageThis In ActiveDocument.Pages
        Set sPageNumThis = pageThis.Shapes.FindShape("pagetotal")
        If Not sPageNumThis Is Nothing Then
            sPageNumThis.Text.Story = CStr(ActiveDocument.Pages.Count)
        End If
    Next pageThis