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)?
Hi,
here is some code as a starting point:
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
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.
This code snippet has modified Mr. Wenkel's submission to eliminate the connectors and only show the shape once per page.
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
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