Solved

Generate Table of Contents for Visio 2010

Posted on 2011-02-24
2
3,312 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
2 Comments
 
LVL 30

Accepted Solution

by:
Scott Helmers earned 500 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

Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

Question has a verified solution.

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

Periodically someone asks me whether there’s a way to automatically convert all of the pages in a Visio drawing to PowerPoint slides. There have even been a few times when I’ve wanted to do that myself but I never really had enough incentive to figu…
Book Review: Using Microsoft Visio 2010 by Chris Roth   Disclaimer: The author of Using Visio 2010 is a friend and fellow Visio MVP. Whether you’re new to Visio or are upgrading to Visio 2010 from a previous version, you will find a lot to like…
Two types of users will appreciate AOMEI Backupper Pro: 1 - Those with PCIe drives (and haven't found cloning software that works on them). 2 - Those who want a fast clone of their boot drive (no re-boots needed) and it can clone your drive wh…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

816 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now