How to speedup the Rename page VBA function ? [closed]

[Zigoto]

Hello,
Assume that I have a document with 50 sheets,
Pages names are from "001" to "051". I want to insert a gap sheet "21" and to restart the page name at "030".
the pages will be named "001", "002", "003", ..., "019","020", "030", "031",...?, "061", "062"

in order to insert this gap, i'm using the folowing

Code Select Expand


         TmpPage="20"
         NouvNumPage="30"
         i=0
         'first pass to prevent using of already assigne page name
         For Each vsoPage In ActiveDocument.Pages
             If Not vsoPage.Background Then
                 If Val(vsoPage.Name) >= Val(TmpPage) Then
                     vsoPage.Name = "P" & Str(i)
                     i = i + 1
                 End If
             End If
         Next
         i = NouvNumPage
         For Each vsoPage In ActiveDocument.Pages
             If Left(vsoPage.Name, 1) = "P" Then
                 vsoPage.Name = Format(Str(i), "000")
                 i = i + 1
             End If
         Next


each vsoPage.Name = xxx instruction take 3 sec

HOW TO SPEED THIS CODE

Ziorg

[Paul Herber]

I just created a 50 page document and then ran your code, it took a fraction of a second.
Do you have any other code running at the same time, maybe detecting other events?

[Zigoto]

Thank to try to help me.

This is true that it can take a few seconds with 50 pages, if the pages are empty.
My working documents are made of about 150 pages, with each page containing around 10 shapes with custom properties not linked to the page name, but connected each other with standard dynamic connectors.

the only thing running in parallel is a non modal UserForm. " UserForm1.Show (vbModeless) " to indicate the current page in progress.

What I suspect is that when you change the page name, visio re-assign to each shape in the page the new name.
Other idea is that as Visio check that the page.name doesn't exist, it takes more time when you have a lot of pages.
Is there a Visio flag to inhibit this page.name check ?

Ziorg

[Paul Herber]

This is true that it can take a few seconds with 50 pages, if the pages are empty.

Er, no, what I was said was that with 50 empty pages renaming takes less than a second. I press the button and it's done. That's with Visio 2003 on an old system, Visio 2007 on a new system is much the same.

150 pages will be a lot slower than 50 and with shapes on each page it will also get slower, however, I just tried your macro on Visio 2003 - 52 seconds, Visio 2007 - 45 seconds. That's ~0.3s/page.

I'm not at all sure about your page renaming assumptions, two pages cannot have duplicate names, well, they can but if you want to find out more then look at the page.name and page.nameU.
If you try to rename a page such that a duplicate name occurs then an exception is caused. You should handle this anyway.

[Albert]

I can't help but notice that you make two passes and rename the pages twice. Rather than do that, you could make a single pass and rename each of them once.  This SHOULD cut the amount of time approximately in half.  Here is some **UNTESTED** code:

Code Select Expand


intPageGap=Val(NouvNumPage)-Val(TmpPage) 

For i = ActiveDocument.Pages.Count To 1 Step -1
       If Not vsoPage.Background Then
                 If Val(vsoPage.Name) >= Val(TmpPage) Then
                       vsoPage.Name = Format(Str(Val(vsoPage.Name) +intPageGap), "000")
                  End if
         End if
Next


[Zigoto]

Thank you Albert,
I restart from your proposal.
I was doing the job twice in order to be sure to have no error renaming a page with an already used name by another page.
It took me some days to remember the  "on error goto / resume next" function.

Let me share my code

Code Select Expand


Sub PageChangeNom()
 
    Dim vsoPage As Visio.Page
    Dim TmpPage, NouvNumPage As String
    Dim i As Integer
    Dim sPageEnCours, sNewPage As String
    Dim sPageTable(512, 1) As String
    Dim iGapPage As Integer
    Dim iPageEnCours As Integer
   
    sPageEnCours = ActiveWindow.Page.Name
   
    NouvNumPage = "025"
   
    iGapPage = 0
    iPageEnCours = Val(sPageEnCours)
   
   
    On Error GoTo ErrorHandler
   
        For i = 1 To ActiveDocument.Pages.Count
            Set vsoPage = ActiveDocument.Pages(i)
            sPageTable(i, 0) = vsoPage.Name ' nom de la page avant renum
            If (Val(vsoPage.Name) >= iPageEnCours) Then
                sPageTable(i, 1) = Format(Str(NouvNumPage + iGapPage), "000")
                iGapPage = iGapPage + 1
            End If
        Next i
        For i = ActiveDocument.Pages.Count To 1 Step -1
            If sPageTable(i, 1) <> "" Then
                Set vsoPage = ActiveDocument.Pages(i)
                vsoPage.Name = sPageTable(i, 1)
            End If
        Next i

        For Each vsoPage In ActiveDocument.Pages
            If Left(vsoPage.Name, 1) = "P" Then
                vsoPage.Name = Right(vsoPage.Name, 3)
            End If
        Next

ErrorHandler:    ' Routine de gestion d'erreur.
    ' Évalue le numéro d'erreur.
    Select Case Err.Number
        Case -2032465665    ' Erreur "cette page existe déjà".
                vsoPage = ActiveDocument.Pages(i)
                vsoPage.Name = "P" & sPageTable(i, 1)
    End Select
    Resume Next   ' Reprend l'exécution au niveau de la ligne à l'origine de l'erreur

End Sub



Ok the code is to be optimized, (it is straight from debug)

Once again EVERYBODY can help.

Ziorg