Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Generate Table of Contents for Visio 2010

Posted on 2011-02-24
2
Medium Priority
?
3,945 Views
Last Modified: 2012-05-11
I've searched online and in EE but haven't been able to find any solutions for this. I have a Visio document which contains around 100 process maps. These are regularly reviewed by our Business Analysis team as we are in the middle of a big project to implement a new system. Each process is on a different page in Visio and it is difficult to keep track of which workflows are in the document and also to find workflows quickly (other than using Control + F and searching all pages, which isn't great as many workflows may contain the same text even though they have different titles).
I could set up a contents page by adding a shape for each page and manually assigning a hyperlink, but this is clearly time consuming and will require the contents to be rearranged each time a process is inserted.
Is there a way of doing this using VBA?
0
Comment
Question by:Karl_mark
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 
LVL 31

Accepted Solution

by:
Scott Helmers earned 2000 total points
ID: 34975584
So this is quick and dirty but it gets the job done...

It extracts all page names, sorts them, deposits them on a new page called Table of Contents  and then creates hyperlinks to each page.

It doesn't have any niceties like checking whether Table of Contents already exists (it will generate an error) and it will run page names right off the bottom of the page.

If you're familiar with VBA, the last problem is relatively easy to solve. The first requires a bit more knowledge about programming Visio.

To use the code, open the VB Editor (Alt+F11) and paste the code into the ThisDocument module.
Sub GenerateTOC()

    Dim arrPages() As String
    
    Dim pg As Visio.Page
    Dim shp As Visio.Shape
    Dim iPageCount As Integer
    Dim dX As Double, dY As Double
    Dim dDeltaY As Double
    Dim HL As Visio.Hyperlink
    
    iPageCount = 0
    ReDim arrPages(250)
    For Each pg In ActiveDocument.Pages
        If Not pg.Background Then
            iPageCount = iPageCount + 1
            arrPages(iPageCount) = pg.Name
        End If
    Next
    
    Call SortAscend_x1(arrPages, 1, iPageCount)

    Set pg = ActiveDocument.Pages.Add
    pg.Name = "Table of Contents"
    'make this the first page
    pg.Index = 1
    ActiveWindow.Page = pg.Name

    dX = 1
    ' set vertical location for first TOC entry
    dY = pg.PageSheet.Cells("PageHeight").Result(visInches) - 0.25
    dDeltaY = 0.15
    
    For i = 1 To iPageCount
        ' draw rectangle
        dY = dY - dDeltaY
        Set shp = pg.DrawRectangle(dX, dY, dX + 3, dY + dDeltaY * 0.9)
        shp.Text = arrPages(i)
        ' set font size, text alignment, border, fill and shadow
        shp.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "8 pt"
        shp.Cells("Para.HorzAlign") = 0
        shp.Cells("LinePattern").Formula = 0
        shp.Cells("FillPattern").Formula = 0
        shp.Cells("ShdwPattern").Formula = 0
        Set HL = shp.Hyperlinks.Add
        HL.SubAddress = arrPages(i)
    Next i

    ActiveWindow.DeselectAll

End Sub
Private Sub SortAscend_x1(ByRef arr, SortStart, SortEnd)
' SortKey identifies column in array by which to sort
' SortStart and SortEnd allow flexibility to sort only selected rows within the array

    Dim i, j As Integer
    Dim Temp1
    
    If SortEnd - SortStart <= 0 Then Exit Sub

    ' bubble sort
    For i = SortEnd - 1 To SortStart Step -1
        For j = SortStart To i
            If arr(j) > arr(j + 1) Then ' Compare neighboring elements
               Temp1 = arr(j)
               arr(j) = arr(j + 1)
               arr(j + 1) = Temp1
            End If
        Next j
    Next i

End Sub

Open in new window

0
 

Author Closing Comment

by:Karl_mark
ID: 34978732
Brillinat Scott, absolutely spot on. Just made a few adjustments to delete existing TOC if it exists and it works perfectly.
0

Featured Post

[Webinar] Lessons on Recovering from Petya

Skyport is working hard to help customers recover from recent attacks, like the Petya worm. This work has brought to light some important lessons. New malware attacks like this can take down your entire environment. Learn from others mistakes on how to prevent Petya like worms.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Scott A. Helmers Partner, Harvard Computing Group Microsoft Visio MVP Background Microsoft has added more enhancements and new features to Visio 2010 than to any release since they purchased the Visio product line in 2000. In addition, the com…
Messaging apps are amazing tools with the power to do a lot of good, but the truth is the process of collaborating with coworkers requires relationships established through meaningful communication - the kind of communication that only happens face-…
This course is ideal for IT System Administrators working with VMware vSphere and its associated products in their company infrastructure. This course teaches you how to install and maintain this virtualization technology to store data, prevent vuln…
Are you ready to place your question in front of subject-matter experts for more timely responses? With the release of Priority Question, Premium Members, Team Accounts and Qualified Experts can now identify the emergent level of their issue, signal…

604 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question