Page numbers for the Shapes in MS Visio

[viki]

I am looking if there is any way to extract the page numbers for the Visio shapes. Ideally, I would need something like the table of contents in MS Word, where you would have the list of the shapes and all the page numbers where those shapes appear.  Is anybody aware of any way to do this (maybe by running a report or creating a macro)?

[Thomas Winkel]

Hi,

here is some code as a starting point:

Code Select Expand


Sub shapes()
    Dim pge As Visio.Page
    Dim shp As Visio.Shape
    Dim rect As Visio.Shape
    Dim shpName As String
    Dim pgeName As String
    Dim pgeNumber As Integer
    Dim pgeCount As Integer
    Dim txt As String
   
    Set rect = ActivePage.DrawRectangle(1, 6, 6, 1)
   
    For Each pge In ActiveDocument.Pages
        For Each shp In pge.shapes
            shpName = shp.Name
            pgeName = shp.ContainingPage.Name
            pgeNumber = shp.ContainingPage.Index
            pgeCount = ActiveDocument.Pages.Count
            txt = shpName & ": " & pgeNumber & "/" & pgeCount & " - " & pgeName
            rect.Text = rect.Text & txt & vbLf
        Next shp
    Next pge
End Sub


[viki]

Thank you for your reply.  It's just , this macro takes into consideration all the shapes, including the connectors. Besides, it lists many of the shapes multiple times.  While I am trying to achieve something like a table of contents, so I can see that such and such shape can be found on such and such page.

[dirkasarus-rex]

This code snippet has modified Mr. Wenkel's submission to eliminate the connectors and only show the shape once per page.

Code Select Expand


Sub shapes()
    'requires that this reference is checked: "Microsoft Scripting Runtime"
    Dim pge As Visio.Page
    Dim shp As Visio.Shape
    Dim rect As Visio.Shape
    Dim shpName As String
    Dim shpIsOneD as Boolean
    Dim pgeName As String
    Dim pgeNumber As Integer
    Dim pgeCount As Integer
    Dim txt As String
    Dim shpInfo as string
    Dim dictShpNmPg as New Dictionary
    Dim dictKey as Variant

    Set rect = ActivePage.DrawRectangle(1, 6, 6, 1)
   
    For Each pge In ActiveDocument.Pages
        For Each shp In pge.shapes
            shpName = shp.Name
            shpIsOneD = shp.OneD
    pgeName = shp.ContainingPage.Name
            pgeNumber = shp.ContainingPage.Index
            pgeCount = ActiveDocument.Pages.Count

            'for uniqueness, add the shape/page to the dictionary
            'using shpIsOneD allows removal of the 1-D connectors
            shpInfo = shpName & ": " & pgeNumber & "/" & pgeCount & " - " & pgeName
            If Not dictShpNmPg.Exists(shpInfo) And Not shpIsOneD then
                dictShpNmPg.Add shpInfo, shpInfo           
            End If
           
            'output the compiled dictionary list
            For Each dictKey In dictShpNmPg.Keys
                rect.Text = rect.Text & dictKey & vbLf
            Next
        Next shp
    Next pge
End Sub


[Yacine]

For what it is worth... Dirkasarus eliminated the connectors, but there's more to it.
In the document you can have duplicate shape names, as their IDs are only unique on a single page.
You'd better work with unique IDs to define them over the whole scope of the document and define an additional "user friendly" identifier ... eg a tag of the shape unique over the entire document ("Tomato-Green-ToothBrush" ).
Only then you can set up the TOC you need.

Tomato-Green-Toothbrush....Page 2
Banana-Red-Shoe..............Page3