Change text in shapes on multiple pages

[VeKa27]

Hi all,

Need some help on this one.. I have a VBA code that i trigger with a button on a page. The code changes the text in a shape. Easy so far.

Sub TextChange()
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150
    Dim vsoCharacters1 As Visio.Characters
    Set vsoCharacters1 = Application.ActiveWindow.Page.Shapes("TxtDate").Characters
    vsoCharacters1.Delete
    vsoCharacters1.Text = " Test  "
    ActiveDocument.DiagramServicesEnabled = DiagramServices
End Sub

This code works..

But now i want to make the code to change the text on multiple shapes in multiple pages. I named the different shapes with the same name "TxtDate" to trigger them all. But i don't know how i can fix the code so it not only shanges the text in the active page but on all pages in my document..

Who is smarter then me?
Thanks in advance.

[wapperdude]

Ignoring the issues of using a named shape, just going with what you have, this will work.
Note:  I changed the code to enter the page name into the shape just as a way to see that the code is going thru the pages.

Code Select Expand


Sub TextChange()
    Dim vsoChars1 As Visio.Characters
    Dim vsoPg As Visio.Page
   
    On Error Resume Next                    'Skips error when page doesn't have the named shape.
    For Each vsoPg In ActiveDocument.Pages
        ActiveWindow.Page = vsoPg
        Set vsoChars1 = vsoPg.Shapes.Item("TxtDate").Characters
        vsoChars1.Delete
        vsoChars1.Text = vsoPg.NameU
    Next
End Sub



However, the following code has an improved error handling scheme, and the code is more concise:

Code Select Expand


Sub TextChange()
    Dim vsoChars1 As Visio.Characters
    Dim vsoPg As Visio.Page
    Dim vsoShp As Visio.Shape
   
    On Error GoTo skip                   'Skips error when page doesn't have the named shape.
    For Each vsoPg In ActiveDocument.Pages
        ActiveWindow.Page = vsoPg
        Set vsoShp = vsoPg.Shapes.Item("TxtDate")
        vsoShp.Text = vsoPg.NameU
skip:
    Next
End Sub


[VeKa27]

Hi Wapperdude,

Many thanks for your quick response.

I tried your 2 codes. The first works but is it possible to freeze the pages? If I activate the code, I see the document loops trough all pages instead of standing on the page where I triggerd the codebutton. I tried with "Äpplication.ScreenUpdating = False" and "Application.EnableEvents = False" but it didn't work..

I gave some priority to your second code because you said it has better error handling but this code didn't workl. Always same error : "Error -2032465660(8db0904)  Can't find Object"
Surprising because your first code finds the objects with that name without any problem.

Any suggestions?

[wapperdude]

That's odd, both ran correctly for me.  I'm not at my computer right now. 

In the first code, replace the on error line with the on error line from the 2nd code.
Then, add the "skip:" line as done in 2nd code. 
Finally, remove the "ActiveWindow.Page = vsoPg" line.  This eliminates the page jumping.

The first code ought to run fine without leaving the button page.

If not, then will need "error free" code.  The idea is to search for every shape with desired name by looping thru all shapes on a page, for every page in the document.  Basic structure would be...

   For each page in document.pages
         For each shape in page.shapes
               If shape.name = "TxtDate" then
                     (Place code to change text here)
               End if
         Next
   Next

Note:  syntax of "IF" statement might be incorrect.

[VeKa27]

Removing the ActiveWindow.page line worked fine. No more page jumping. :-)

Just changing the error lines results in the same error.. (can't find object) If I switch again the code works. What is best, resume next or goto skip (when works)?
What do you suggest to be the best to implement as code. Knowing that multiple users will use the document. Th 3th code you gave works also fine. like this:

Dim vsoChars1 As Visio.Characters
Dim vsoPg As Visio.Page
On Error Resume Next
For Each vsoPg In ActiveDocument.Pages
         For Each Shape In Page.Shapes
               If Shape.Name = "TxtDate" Then
        Set vsoChars1 = vsoPg.Shapes.Item("TxtDate").Characters
        vsoChars1.Delete
        vsoChars1.Text = "Test"
               End If
         Next
   Next

[wapperdude]

The 3rd code is best.  You shouldn't need the On Error line with the 3rd version. 

[VeKa27]

Ok Wapperdude.. Gonna build 3th code into my document..
When finished, I'll come back to you one more time.
I'm now very thankful to you