Manage a Page Listing in TheDoc Shapesheet

[visProcessEng]

The objective was to produce a list of Pages in a given document, that would be available from any shape within the document.

This is would allow a given fixed list type ShapeData row, to reference "TheDoc!User.Page_Listing", and in this way facilitate cross sheet referencing.

NOTE: work still to be done includes addressing the "Delete Page" case.

The next step will be to modify this code to (in a similar fashion) listings of shapes on a page, by some filtering value (like common Masters).

I know that this code could be improved by leveraging the common code between the "Document Created", "Page Added" subs; probably in many other ways.

But it works, pretty well even if orphaned page references are allowed to exist.  I will replace with the final code, but don't hold your breath.

Thanks to Lars for the tip on "Code" Tags.

Please note that the VBA Code should be pasted into "TheDocument" module using the VBA Editor.

Code Select Expand


Private Sub Document_DocumentCreated(ByVal doc As IVDocument)


    Dim visDoc As Visio.Document
    Dim visPage As Visio.Page
    Dim visShape As Visio.Shape
    Dim visCell As Visio.Cell
    Dim visSect As Visio.Section
    Dim visRow As Visio.Row
    Dim sectionpresent As Boolean
    Dim pagename As String
    Dim rowname As String
    Dim rownum As Integer
    Dim cellname As String
    Dim pagenameformula As String
   
    Set visDoc = Application.ActiveDocument
    Set visPage = visDoc.Pages(1)
     
    pagename = visPage.Name
    rowname = Replace(pagename, "-", "_")
   
'Open TheDocument ShapeSheet Window
    visPage.PageSheet.OpenSheetWindow

'Exposes ThePage ShapeSheet to Shape Methods
        Set visShape = Application.ActiveWindow.Shape

'Create User-defined Cells Section in the page just added
        visShape.AddSection visSectionUser

'Create Row named "Page_#" Section in the page just added
        rowname = Replace(pagename, "-", "_") 'it is required to format rowname a shapesheet acceptable format
        visShape.AddNamedRow visSectionUser, rowname, visTagDefault

'Capture cellname for future reference
         cellname = "User." & rowname
         
'Write the pagename() formula to the value cell of the row
    Set visCell = visShape.Cells(cellname)
    visCell.Formula = "pagename()"
       
'Close ThePage ShapeSheet Window
     Application.ActiveWindow.Close
       
     
'Open TheDocument ShapeSheet Window
    visDoc.DocumentSheet.OpenSheetWindow
   
'Exposes Document ShapeSheet to Shape Methods
    Set visShape = Application.ActiveWindow.Shape
'If the Scratch Section is not present, create it.
    If Not (visShape.SectionExists(visSectionScratch, 1)) Then
        Application.ActiveWindow.Shape.AddSection visSectionScratch
    End If
   
    Set visSect = Application.ActiveWindow.Shape.Section(visSectionScratch)
   
'Next just add a row to to the scratch section capture page info
    visShape.AddRow visSectionScratch, visRowLast, visTagDefault
   
'Generate page name reference formula for insertion into TheDocument Scratch Section
    pagenameformula = "Pages[" & pagename & "]!ThePage!User." & rowname
   
'Capture row count for use in cellname
    rownum = visSect.Count
'Generate cellname for cell reference
    cellname = "Scratch.A" & rownum
    Set visCell = visShape.Cells(cellname)
       
    visCell.Formula = pagenameformula
   
'If not already present in the document Create User-defined Cells Section in TheDocument Shapesheet
    If Not (visShape.SectionExists(visSectionUser, 0)) Then
            visShape.AddSection visSectionUser
    End If

'Create Row named "Page_Listing" Section in the page just added
        visShape.AddNamedRow visSectionUser, "Page_Listing", visTagDefault
       
        Set visCell = visShape.Cells("user.Page_Listing")
        visCell.Formula = cellname

     Application.ActiveWindow.Close


End Sub


Private Sub Document_PageAdded(ByVal Page As IVPage)

    Dim visDoc As Visio.Document
    Dim visPage As Visio.Page
    Dim item As Visio.Page
    Dim visShape As Visio.Shape
    Dim visCell As Visio.Cell
    Dim visSect As Visio.Section
    Dim visRow As Visio.Row
    Dim sectionpresent As Boolean
    Dim pagename As String
    Dim pagecnt As Integer
    Dim userpgname As String
    Dim rowname As String
    Dim rownum As Integer
    Dim cellname As String
    Dim pagenameformula As String
    Dim pageslisting As String
    Dim concatstr As String
   
    Set visDoc = Application.ActiveDocument
    Set visPage = Page
     
    userpgname = ""
     
'get number of current pages
    pagecnt = visDoc.Pages.Count
       
'get current page name
    pagename = visPage.Name
   
'Trap user supplied name
    If pagename <> "Page-" & pagecnt Then
    userpgname = pagename
    pagename = "Page-" & pagecnt
    visPage.Name = pagename
    End If
     
    rowname = Replace(pagename, "-", "_")
   
'Open TheDocument ShapeSheet Window
    visPage.PageSheet.OpenSheetWindow

'Exposes ThePage ShapeSheet to Shape Methods
        Set visShape = Application.ActiveWindow.Shape

'Create User-defined Cells Section in the page just added
        visShape.AddSection visSectionUser

'Create Row named "Page_#" Section in the page just added
        rowname = Replace(pagename, "-", "_") 'it is required to format rowname a shapesheet acceptable format
        visShape.AddNamedRow visSectionUser, rowname, visTagDefault

'Capture cellname for future reference
         cellname = "User." & rowname
         
'Write the pagename() formula to the value cell of the row
    Set visCell = visShape.Cells(cellname)
    visCell.Formula = "pagename()"
       
'Close ThePage ShapeSheet Window
     Application.ActiveWindow.Close
     
'**************************************
'Open TheDocument ShapeSheet Window
    visDoc.DocumentSheet.OpenSheetWindow
   
'Exposes Document ShapeSheet to Shape Methods
    Set visShape = Application.ActiveWindow.Shape
   
   
'If the Scratch Section is not present, create it.
    If Not (visShape.SectionExists(visSectionScratch, 1)) Then
        Application.ActiveWindow.Shape.AddSection visSectionScratch
     End If
   
    Set visSect = Application.ActiveWindow.Shape.Section(visSectionScratch)
   
'Next just add a row to to the scratch section capture page info
    visShape.AddRow visSectionScratch, visRowLast, visTagDefault
   
'Generate page name reference formula for insertion into TheDocument Scratch Section
    pagenameformula = "Pages[" & pagename & "]!ThePage!User." & rowname
   
'Capture row count for use in cellname
    rownum = visSect.Count
'Generate cellname for cell reference
    cellname = "Scratch.A" & rownum
    Set visCell = visShape.Cells(cellname)
       
    visCell.Formula = pagenameformula

'**************************************
'if a user supplied page name was trapped reset the pagename to the user supplied page name
    If userpgname <> "" Then
    visPage.Name = userpgname
    End If
'***************************************
'Generate cellname for cell reference to assign Page Listing
    cellname = "User.Page_Listing"
    Set visCell = Application.ActiveWindow.Shape.Cells(cellname)
   
'CONSTRUCT Pages Listing String
'For Each Page add entry in "Page_Listing" Section of TheDocument

pageslisting = ""
concatstr = ""



For Each item In visDoc.Pages
    If item = visDoc.Pages(1) Then
        pageslisting = """" & item.Name
    Else
        pageslisting = pageslisting & ";" & item.Name
    End If
Next item
        pageslisting = pageslisting & """"
        Set visCell = visShape.Cells(cellname)
        visCell.Formula = pageslisting

     Application.ActiveWindow.Close
     
End Sub