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
tried inserting these code sections but got a strange error:
Do you declare sPageNumThis anywhere?
E.g., dim sPageNumThis as shape?
that helps...not sure why I need to do that now since it ran fine before I inserted the new code.
sill having an issue and not sure how this new setup runs and does not run when I don't need it to. Here is what I have:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
Option Explicit Public blnSuppressUpdate As Boolean Sub set_suppress_renumber_true() blnSuppressUpdate = True End Sub Sub set_suppress_renumber_false() blnSuppressUpdate = False End Sub Sub update() MsgBox "Page renumbering would take place now." Dim pageThis As Page Dim s As Shape Dim sPageNumThis As Shape ActiveDocument.BeginCommandGroup Optimization = True 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 Optimization = False ActiveWindow.Refresh ActiveDocument.EndCommandGroup End Sub
here is the thismacrostorage code
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
Option Explicit Dim WithEvents CurDoc As Document Private Sub GlobalMacroStorage_WindowActivate(ByVal Doc As Document, ByVal Window As Window) Set CurDoc = Doc End Sub Private Sub GlobalMacroStorage_WindowDeactivate(ByVal Doc As Document, ByVal Window As Window) Set CurDoc = Nothing End Sub Private Sub CurDoc_PageCreate(ByVal Page As Page) If Not blnSuppressUpdate Then update End If End Sub Private Sub CurDoc_PageDelete(ByVal Count As Long) If Not blnSuppressUpdate Then update End If End Sub
grogo said:that helps...not sure why I need to do that now since it ran fine before I inserted the new code.
Did you have "Option Explicit" in your code module before adding the new code?
grogo said:having an issue and not sure how this new setup runs and does not run when I don't need it to.
I copied the code from your post, then pasted it into modules in a project in 2019. It works the way that I would expect it to.
When I add or remove a page, it runs the Update sub.
If I run the set_suppress_renumber_false sub, then adding or removing a page does not run the Update sub.
If I run the set_suppress_renumber_true sub, then adding or removing a page, again, runs the Update sub.
If you need more tools for figuring out what is going on, you might look at:
finally success Eskimo. You are still awesome and generous.