VBA code to rename page name with shape data

[WCTICK]

Hello,

I am trying to figure out how to rename the page name in a Visio Table of Organization using the shape data Department field from the first shape on the page and do that for each page in the chart.

So, for the first page, the top shape has a shape data property field named Department with a value of "Directors Office".  I want to rename the default page-1 name to "Directors Office".

Any assistance/advice would be much appreciated.  Thank you.

[wapperdude]

You can do something like this:

Code Select Expand


Sub Macro2()
    Dim vShp as Visio.shape

    Set vShp = ActiveWindow.Page.Shapes.ItemFromID(1)
    PgName = vShp.CellsU("User.PgNm").ResultStr(none)
   
    ActivePage.Name = PgName


End Sub



[WCTICK]

Thank you for the response.  I apologize for my lack of knowledge/experience with VBA coding.

I copied the macro and ran in debug to see what results I obtained.

vshp variable gets set to Sheet.1

vShp.CellsU("User.PgNm").ResultStr(none) show = <  and the next step results in Unexpected end of file.

Do I need to add something to select the desired cell/shape?

The first shape on the page that I want to use data from to rename the page name contaians prop.department of "Directors Office"

[wapperdude]

The code supplied was merely to show a possible construct to the macro and some key syntax.

The 1st line determines which shape is desired.  There are various ways to do it.  Typically, you would select the shape before running the macro, and then have the code read which shape had been selected.  The example is hard coded to look at the 1st shape on the page.

Once shape is determined, the 2nd line looks for the cell in the shapesheet that has the desired info.  In the example, an entry had been made in the User Section, named "PgNm".  The syntax shows the basic form for receiving the info.  If the referenced cell does not exist the code dies due to error. 

The final line code does the actual page renaming.  Note, Visio has both a local and universal name for the page.  These stay in sync with 1st name change.  However, additional name changes per each page and only the local name changes.  Inconvenient.  It is possible to relaunch the names.  If you want to test the code, instead of the variable PgName, enter something within tho quotes.

[WCTICK]

Once again, thanks for the assistance (and patience).  I was able to get the macro to work by navigating to each page and running it using the code below.

Dim vShp As Visio.Shape

    Set vShp = ActiveWindow.Page.Shapes.ItemFromID(1)
    PgName = vShp.CellsU("Prop.Department").ResultStr(" ")
   
    ActivePage.Name = PgName

I would like to add code so the macro will iterate through each page in the document and change the page name.

I tried adding

  For Each Pg In Application.ActiveDocument.Pages

Set vShp = ActiveWindow.Page.Shapes.ItemFromID(1)
    PgName = vShp.CellsU("Prop.Department").ResultStr(" ")
   
    ActivePage.Name = PgName

Next

which doesn't work.  Can you offer another suggestion for correcting that?  Thank you.

[WCTICK]

I would like to add code so the macro will iterate through each page in the document and change the page name.

I tried adding
Well, yellow text didn't show up well in my previous post.


For Each Pg In Application.ActiveDocument.Pages

Set vShp = ActiveWindow.Page.Shapes.ItemFromID(1)
    PgName = vShp.CellsU("Prop.Department").ResultStr(" ")
   
    ActivePage.Name = PgName

Next

which doesn't work.  Can you offer another suggestion for correcting that?  Thank you.

[Paul Herber]

Code Select Expand


  For Each Pg In Application.ActiveDocument.Pages

    Set vShp = Pg.Shapes.ItemFromID(1)
    PgName = vShp.CellsU("Prop.Department").ResultStr(" ")
    Pg.Name = PgName

  Next


[WCTICK]

That did it!  Thank you very much, Visio guys.

[Paul Herber]

But it will break if :

• there is no valid shape with ID=1 or
• if the shape doesn't have a cell "Prop.Department" or
• if the cell contains invalid text for a page name, or
• even a duplicate page name.

[wapperdude]

Here are alternative ways to select a shape on a page:
uncomment a line to try/use that line.  Note, if more than one shape on page, but you still want just a single shape, preselecting is easiest, but values other than"1" may be used to specify a shape."1" will always be 1st shape.

Code Select Expand


Sub Macro1()
    dim vShp as Visio.shape

    ActiveWindow.DeselectAll

'    ActiveWindow.Page.Shapes.ItemFromID (1), visSelect
'    Set vShp = ActivePage.Shapes.ItemFromID(1)
'    Set vShp = ActiveWindow.Page.Shapes.ItemFromID(1)
'    Set vShp = ActiveWindow.Selection(1)    'Pre-selected
'    Set vShp = ActivePage.Shapes.Item(1)

   
'    ActiveWindow.Select vShp, visSelect   'This makes the shape ACTIVE
   
End Sub


For convenience, here are ways to step thru shapes on a page.

Code Select Expand

 
'Method1:
'    For Each vsoShp In ActivePage.Shapes      'Checks every shape on page
'        Debug.Print vsoShp
'    Next

'Method2:
'    shpCnt = ActivePage.Shapes.Count 
'    For i = 1 To shpCnt Step 1
'        Set vsoShp = ActivePage.Shapes.ItemU(i)
'        Debug.Print vsoShp
'    Next
     
'Method3:good when you want to delete shapes
'    shpCnt = ActivePage.Shapes.Count 
'    For i = shpCnt To 1 Step -1
'        Set vsoShp = ActivePage.Shapes.ItemU(i)
'        Debug.Print vsoShp
'    Next


[WCTICK]

Thanks for the additional information.  I'm looking/working through it and learning a lot.  Really appreciate your input and knowledge.