Making the Off-Page Reference Hyperlink URL Safe

One of my favourite shapes in Visio is the Off-page reference shape on the Basic Flowchart Shapes stencil. I have written about this shape before ( see http://blog.bvisual.net/2011/09/02/page-grids-and-off-page-references/ ) but I did not notice a slight issue with it previously, so this article show how to overcome a couple of issues that I discovered whilst working on a project recently.

The shape is so useful for creating links between different pages and shapes within a Visio document (and can even be used to link between Visio documents), but it achieves this is a couple of ways. When dropped on to a page, it runs an add-on to prompt for the creation of a paired shape on an existing or new page.

These two shapes work as a pair, and have reciprocal hyperlinks between them. When in Visio, the normal action is to double-click one of the shapes, and the hyperlink is followed to the paired shape. Actually, the double-clink fires the OPC add-on with a particular argument passed to it, which then reads the contents of some specific user-defined cells that hold the unique ids of the target page and shape. However, the add-on also creates a hyperlink on the shapes, which provides an alternative method of jumping from one shape to another.

I find that this second method often only works on every second attempt in Visio, but it is the only method that can be used when the Visio document is viewed in a SharePoint web page using Visio Services, saved as PDF or XPS, or even as a web-page.

There are, however, two instances when these hyperlinks fail to work.:

Firstly, when a page is renamed after the Off-page reference shape has been created, or if the Off-page reference page is moved between pages, then the target page name does not updated in the shape.

Secondly, when the target page contains special characters, then the URL fails because the hyperlink requires URL Safe Encoded strings (see http://www.w3schools.com/tags/ref_urlencode.asp ).

Therefore, I had to write a macro to update the hyperlinks to cater for these potential failures.

The first function needs to convert any given text into a url safe encoded text:

Private Function URLSafeEncode(ByVal txtIn As String) As String
Dim txtOut As String
Dim c As String
Dim t As String
Dim i As Integer

    For i = 1 To Len(txtIn)
        c = Mid(txtIn, i, 1)
        If Asc(c) < 48 Or Asc(c) > 122 Then
            t = "%" & Hex(Asc(c))
        Else
            t = c
        End If
        txtOut = txtOut + t
    Next
    URLSafeEncode = txtOut
End Function

The second function returns the page object for a provided page unique id:

Private Function GetPageFromUID(ByVal doc As Visio.Document, _
    ByVal uid As String) As Visio.Page
Dim pag As Visio.Page
    For Each pag In doc.Pages
        If pag.PageSheet.UniqueID(Visio.VisUniqueIDArgs.visGetOrMakeGUID) = uid Then
            Set GetPageFromUID = pag
            Exit For
        End If
    Next
End Function

The third function simply returns the shape object for a provided unique id:

Private Function GetShapeFromUID(ByVal pag As Visio.Page, _
    ByVal uid As String) As Visio.Shape
Dim shp As Visio.Shape
On Error Resume Next
    Set GetShapeFromUID = pag.Shapes.ItemFromUniqueID(uid)

End Function

Finally, these  functions can be called by a sub function :

Public Sub FixHyperlinks()
Dim pag As Visio.Page
Dim shp As Visio.Shape
Dim hyp As Visio.Hyperlink
Dim mstCheck As Visio.Master
Dim mst As Visio.Master
Dim sel As Visio.Selection
Dim pagTo As Visio.Page
Dim shpTo As Visio.Shape
Dim puid As String
Dim suid As String
Dim p As String
Dim s As String
Dim h As String
Dim addText As Boolean
    For Each mstCheck In Visio.ActiveDocument.Masters
        If mstCheck.NameU = "Off-page reference" Then
            Set mst = mstCheck
            Exit For
        End If
    Next
    
    If mst Is Nothing Then
        MsgBox "The Off-page reference master has not been used in this document.", vbExclamation
        Exit Sub
    Else
        addText = CBool(MsgBox("Add target page / shape names as text?", vbYesNo))
    End If
    
    For Each pag In Visio.ActiveDocument.Pages
        Set sel = pag.CreateSelection(visSelTypeByMaster, 0, mst)
        For Each shp In sel
            For Each hyp In shp.Hyperlinks
                p = ""
                s = ""
                h = ""
                If Len(hyp.SubAddress) > 0 Then
                    If hyp.Name = "OffPageConnector" _
                        And shp.CellExists("User.OPCDPageID", Visio.visExistsAnywhere) <> 0 Then
                        'Get the unique id of the target page
                        puid = shp.Cells("User.OPCDPageID").ResultStr("")
                        Set pagTo = GetPageFromUID(pag.Document, puid)
                        If Not pagTo Is Nothing Then
                            pagTo.NameU = pagTo.Name
                            If Not pagTo Is pag Then
                                p = URLSafeEncode(pagTo.Name)
                            End If
                            'Get the unique id of the target shage
                            suid = shp.Cells("User.OPCDShapeID").ResultStr("")
                            Set shpTo = GetShapeFromUID(pagTo, suid)
                            If Not shpTo Is Nothing Then
                                shpTo.NameU = shpTo.Name
                                s = URLSafeEncode(shpTo.Name)
                            End If
                        End If

                        If Len(p) > 0 Then
                            If Len(s) > 0 Then
                                h = p & "/" & s
                            Else
                                h = p
                            End If
                        ElseIf Len(s) > 0 Then
                            h = URLSafeEncode(pagTo.Name) & "/" & s
                        End If
                            
                        If addText Then
                            If Len(p) > 0 Then
                                If Len(s) > 0 Then
                                    shp.Text = pagTo.Name & "/" & shpTo.Name
                                Else
                                    shp.Text = pagTo.Name
                                End If
                            ElseIf Len(s) > 0 Then
                                shp.Text = shpTo.Name
                            End If
                        End If
                    End If
                    
                    If Len(h) > 0 Then
                        hyp.SubAddress = h
                    End If
                End If
            Next
        Next
    Next
    
End Sub

The end result is a macro that fixes the hyperlinks to be url safe encoded, corrects any page name changes due to page renaming or moving shapes between pages, and optionally adds the text of the destination page and shape to the Off-page reference shape.

One extra benefit of this macro is that it sets the destination shape in the hyperlink, which is missing from the one generated by the OPC add-on.

In fact, the pairs of Off-page reference shapes can be on the same page, but one of them will need to be moved from a different page back on to the desired page, because the add-on insists that it is created on a different page than the original shape.

Of course, it would be better if Microsoft added these features into the OPC add-on…..