Option Explicit 
 
Sub TableOfContents() 
     ' creates a shape for each page in the drawing on the first page of the drawing
     ' then add a dbl-clk GoTo to each shape so you can double click and go to that Page
     
    Dim PageObj   As Visio.Page 
    Dim TOCEntry  As Visio.Shape 
    Dim CellObj   As Visio.Cell 
    Dim PosY      As Double 
    Dim PageCnt   As Double 
     
     ' ActiveDocument.Pages.Count will give the number of pages, but we are interested
     ' the number of foreground pages
    PageCnt = 0 
    For Each PageObj In ActiveDocument.Pages 
        If PageObj.Background = False Then PageCnt = PageCnt + 1 
    Next 
     
     ' loop through all the pages
    For Each PageObj In ActiveDocument.Pages 
        If PageObj.Background = False Then ' Only foreground pages
             
             ' where to put the entry on the page?
            PosY = (PageCnt - PageObj.Index) / 4 + 1 
             
             ' draw a rectangle for each page to hold the text
            Set TOCEntry = ActiveDocument.Pages(1).DrawRectangle(1, PosY, 4, PosY + 0.25) 
             
             ' write the page name in the rectangle
            TOCEntry.Text = PageObj.Name 
             
             ' add a link to point to the page to you can just go there with a Double Click
            Set CellObj = TOCEntry.CellsSRC(visSectionObject, visRowEvent, visEvtCellDblClick) 'Start
            CellObj.Formula = "GOTOPAGE(""" + PageObj.Name + """)" 
             
        End If 
    Next 
     
     'Clean Up
    Set CellObj = Nothing 
    Set TOCEntry = Nothing 
    Set PageObj = Nothing 
End Sub