We help IT Professionals succeed at work.

Creating an automatic index of all sheet names in a visio drawing

bswerdfeger
bswerdfeger asked
on
2,852 Views
Last Modified: 2012-06-22
I am looking for a field tag or macro to generate an index of all sheets names in a visio file..
Comment
Watch Question

Scott HelmersVisio Consultant, Trainer, Author, and Developer
CERTIFIED EXPERT
Most Valuable Expert 2011

Commented:
You didn't mention the format in which you'd like to see the output, so I've provided two options.

PageNames1 will display the page names on the screen.

PageNames2 will write the output to a text file.

Note that both of these macros will list/write foreground pages only. If you also want to see background page names, remove the IF statement that tests for the .background property.
Public Sub PageNames1()
' List the names of the pages in the current doc
Dim PagObj As Visio.Page
Dim indx As Integer, PrevPage As String, NextPage As String
 
For Each PagObj In ActiveDocument.Pages
    indx = PagObj.Index
    'IF statement excludes any background pages; remove IF to see all pages
    If ActiveDocument.Pages(indx).Background = False Then
        Debug.Print PagObj.Index; " "; PagObj.Name;
    End If
Next
End Sub
 
Public Sub PageNames2()
' Writes the names of the pages in the current doc to a text file
Dim PagObj As Visio.Page
Dim indx As Integer, PrevPage As String, NextPage As String
 
Open "C:\PageNameList.txt" For Output Shared As #1
 
For Each PagObj In ActiveDocument.Pages
    indx = PagObj.Index
    'IF statement excludes any background pages; remove IF to see all pages
    If ActiveDocument.Pages(indx).Background = False Then
        Print #1, PagObj.Index; " "; PagObj.Name
    End If
Next
 
Close #1
End Sub

Open in new window

Author

Commented:
I need the index of sheet names as text in visio shape in the same visio drawing.
The text file output would work but it would require a manual copy and paste back into a visio shape.

It looks like the code could be easilly modified to write to a shape.  I presume the shape would required a unique name in order to preserve its shape, font and paragraph properties preserved everytime the code was run.

Is there not a built in field or VB function to access the File, Properties, Content ?
All the pages are listed and selectable but will they not copy into the clipboard.
Scott HelmersVisio Consultant, Trainer, Author, and Developer
CERTIFIED EXPERT
Most Valuable Expert 2011

Commented:
There is a field you can insert into a shape to show the current page name, but only the name of the current page. To do that, select a shape on the page, then select Insert/Field... from the main menu. In the fields dialog, select Page Info in the Category box, then Name in the Field Name box.

You can also access the page name from VB, which is what the two macros I attached previously do.

To automate the entire function though, you are correct that you need a container on the page to accept the page name list. You can draw one from your VBA code if you would like, or as you suggest, just leave one on the page with a known name that you can access from your code.

The code below does exactly this for a shape with the name "PageNameList".
Public Sub PageNames4()
' Write the names of the pages in the current doc to a shape
' on the current page called "PageNameList"
Dim PagObj As Visio.Page, PgActive As Visio.Page
Dim vsoCharacters As Visio.Characters
Dim indx As Integer
Dim PageNames As String
 
 
For Each PagObj In ActiveDocument.Pages
    indx = PagObj.Index
    'IF statement excludes any background pages; remove IF to see all pages
    If ActiveDocument.Pages(indx).Background = False Then
        'chr(10) and chr(13) are line feed and carriage return, respectively
        PageNames = PageNames & PagObj.Index & " " & PagObj.Name & Chr(10) & Chr(13)
    End If
Next
 
Set PgActive = Application.ActiveWindow.Page
Set vsoCharacters = PgActive.Shapes.Item("PageNameList").Characters
vsoCharacters.Text = PageNames
 
End Sub

Open in new window

Author

Commented:
That works..
I appreciate your help.
I 'm new to Visio's flavor of VB commands and having to do an extremely fast learning curve.

Two more items to work out with the "PageNameIndex" object macro.

1. After running the macro I would like the height of the object to automatically fit the number of lines of text.
'auto adjust the height of the PageNameList to fit the text
Me.PagObj.Height = autofit  ' or something to that effect

2. How do I creating button on page that calls the correct macro in module 1 and the buttons print property is false.





Public Sub VisioSheetNameIndex()
' Write the names of the pages in the current doc to a shape
' on the current page called "PageNameList"
Dim PagObj As Visio.Page, PgActive As Visio.Page
Dim vsoCharacters As Visio.Characters
Dim indx As Integer
Dim PageNames As String
 
For Each PagObj In ActiveDocument.Pages
    indx = PagObj.Index
    'IF statement excludes any background pages; remove IF to see all pages
    If ActiveDocument.Pages(indx).Background = False Then
        PageNames = PageNames & Trim(PagObj.Index) & " " & Trim(PagObj.Name) & vbCrLf
    End If
Next
 
Set PgActive = Application.ActiveWindow.Page
Set vsoCharacters = PgActive.Shapes.Item("PageNameList").Characters
vsoCharacters.Text = PageNames
 
'auto adjust the height of the PageNameList to fit the text
 
End Sub

Open in new window

Visio Consultant, Trainer, Author, and Developer
CERTIFIED EXPERT
Most Valuable Expert 2011
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION

Author

Commented:
Thanks again Scott.
FYI  - I figured out how to create a non printing command button.  RTGDB....

For reference this is my final working code snippet.

Off topic question  - why do you prefer Chr(10) & Chr(13) over VBcrLF ?

Option Explicit
 
Public Sub VisioSheetNameIndex()
' Many thanks to Scott oin Expert Exchange
 
' Write the names of the pages in the current doc to a shape
' on the current page called "PageNameList"
' To name the object select it and
' use menu's: <format> <Special> and define <name> field as "PageNameList"
 
    Dim PagObj As Visio.Page, PgActive As Visio.Page
    Dim vsoCharacters As Visio.Characters
    Dim vsoShape As Visio.Shape
    Dim sindex, indx As Integer
    Dim PageNames As String
    Dim DwgCnt As Integer
    
    For Each PagObj In ActiveDocument.Pages
        indx = PagObj.Index
        'IF statement excludes any background pages; remove IF to see all pages
        If ActiveDocument.Pages(indx).Background = False Then
                PageNames = PageNames & Trim(PagObj.Index) & " " & Trim(PagObj.Name) & vbCrLf
        End If
    Next
     
    'remove extra blank line created by CR-LF or equivalent vbCrLf
    PageNames = Left(PageNames, Len(PageNames) - 2)
     
    'paste in sheet name text and adjust the height of the PageNameList object to fit the text
    Set PgActive = Application.ActiveWindow.Page
    Set vsoShape = PgActive.Shapes.Item("PageNameList")
    vsoShape.Characters.Text = PageNames
    vsoShape.Cells("TxtHeight").Formula = "=TEXTHEIGHT(TheText,TxtWidth)"
    vsoShape.Cells("Height").FormulaForce = "TxtHeight*1"
 
    'Let the user know the index is updated.
    MsgBox ("Drawing index updated.")
End Sub

Open in new window

Scott HelmersVisio Consultant, Trainer, Author, and Developer
CERTIFIED EXPERT
Most Valuable Expert 2011

Commented:
Thanks for posting your version of the code.

On topic: I realized as I was driving to pick up my daughter that you don't actually need a command button (printable or otherwise) if you don't want one. You can just associate the macro with the double-click action for the PageNameList shape itself. Double-click it and it updates itself! The symmetry of it kind of appeals to me.

Off topic: why didn't I use vbCrLf? Didn't know about it. My feeble brain holds just so many enumerations and I haven't run across that one or had forgotten it. But, curiously, the ASCII values for CR and LF still come readily to mind even though I learned them decades ago...

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.