Modifying Table of Contents code to include shape data from top shape on page

[WCTICK]

Hi,

I have a vba script (See below) that creates a table of contents on the first page of a Visio Org Chart and displays the page name and number.
I would like to modify it so instead of the page number, it shows the position number associated with the top shape on each page.  The Position Number is one of the shape data fields.

The line below currently displays the page number.  That is what I want to replace with the Shape data field for the top shape on the page.

TOCEntryPage.Text = PageToIndex.Index


I haven't been able to figure out the best way to accomplish this.  Any suggestions?



Sub CreateTableOfContents()

    ' creates a shape for each page in the drawing on the first page of the drawing
    ' then adds a hyperlink to each shape so you can click and go to that Page

    ' define a toc shape
    Dim TOCEntry As Visio.Shape
    Dim TOCEntryPage As Visio.Shape
    Dim PageToIndex As Visio.Page

    ' loop through all the pages you have
    For Each PageToIndex In Application.ActiveDocument.Pages

        If PageToIndex.Background Then Exit For

        ' where to put the entry on the page?
        Dim X As Integer

        ' you may want to refine this and use a top down algorithm with something smaller than 1 inch increments.
        X = PageToIndex.Index

        ' draw a rectangle for each page to hold the text
        Set TOCEntry = ActiveDocument.Pages(1).DrawRectangle(14, 10 - (X * 0.25), 17, 10 - (X + 1) * 0.25)
        Set TOCEntryPage = ActiveDocument.Pages(1).DrawRectangle(17, 10 - (X * 0.25), 18, 10 - (X + 1) * 0.25)

        ' write the page name in the rectangle
        TOCEntry.Text = PageToIndex.Name
        TOCEntryPage.Text = PageToIndex.Index

       
       
    Next

End Sub

[Thomas Winkel]

Hi,

I assume that the top shape is a heading and that a page only contains one heading.
Then you could do something like this:

Code Select Expand


txt = "No Top Shape found"
For Each shp In PageToIndex.Shapes
    If shp.CellExists("Prop.PositionNumber", False) Then
        txt = shp.Cells("Prop.PositionNumber").ResultStr(visNone)
        Exit For
    End If
Next shp
TOCEntryPage.Text = txt


In my Visio projects I have a unique User cell that indicates the function of a shape: User.TypeId = "Heading"

[WCTICK]

Thanks for the suggestion and sample code.  I will give it a try.