I have previously written about using off-page references and labelled page grids in Visio, see A Page Grid with Labels and Page Grids and Off Page References, however a reader pointed out that the label on the Off-Page Reference shape is duplicated on both ends. This is not always ideal, however it is all I could do using just ShapeSheet formulas alone. So, in this article, I show how a VBA macro can enhance the reciprocal labels on the twin Off-Page Reference shapes, and they automatically update if either end is moved between grids. This is especially useful in electrical wiring diagrams, but the principal can be adapted for other purposes.
My previous articles explain that the Off-page reference shape uses the OPC add-on, and contains a slightly modified version in of this master, along with a custom GridLabel and GridLines masters. I have created a more up-to-date version as Page Grid With OPC.vsdx for downloading.
If this document is placed in OneDrive or SharePoint Online, then it can be edited. The Off-page reference shapes can be moved, and the label of twin shapes will be automatically updated with the grid reference of its destination. The hyperlinks can be followed with the CTRL-Click on each Off-page Reference shape.
In Visio desktop, the Off-page reference shapes can be double-clicked, and the destination twin shape will also be selected. This is because the OPC add-on is built-in to Visio desktop, whereas currently the hyperlink navigation only opens the target page.
Running the Enhance OPCs macro
All of the VBA code is in the Enhanced OPC.vssm macro-enabled stencil, which can be downloaded and placed into the My Shapes folder. It will then be available to open in the Visio UI. It contains just one master, Enhance OPCs, which can be dragged and dropped on to any page in the above Visio document. This can be done anytime after adding more of the Off-page reference shapes available from the Document Stencil or the Basic Flowchart stencil, as it will enhance each of the instances.
The code iterates through each page, and selects all instances of the Off-page reference shape. It then checks that the User.OPCDPageID cell exists because this contains the unique ID of the destination page. This is automatically entered by the Microsoft OPC add-on, as is the unique ID of the destination shape in the User.OPCDShapeID cell.
This existing ShapeSheet formula, =RUNADDONWARGS(“OPC”,”/CMD=3″), in the TheText cell calls this OPC add-on and updates the text of the twin shape whenever the text is changed. This is why the existing functionality has identical text in each of the twin shapes, so the macro removes this, and instead, inserts a a formula into the User.visEquivTitle.Prompt cell. The previous articles used the User.visEquivTitle.Value cell to store the row and column label text, so all that this macro does is create a reference to this call in the twin shape:
"=Pages[" & trgtPage & "]!Sheet." & trgtShape.ID & "!User.visEquivTitle"
This cell reference can then be inserted into the text block of the shape, and it will thus be automatically updated if the destination shape is moved within its page to a different grid reference.
I needed two helper functions, GetShape and GetMasterU, before using them in the EnhanceTheOPCs function.
GetShape function
This function returns the shape specified with the unique IDs of the destination page and shape, or nothing if it does not exist.
Private Function GetShape(ByVal pageUID As String, ByVal shapeUID As String) As Visio.Shape
On Error GoTo errHandler
Dim pag As Visio.Page
Dim shp As Visio.Shape
For Each pag In ActiveDocument.Pages
If pag.PageSheet.UniqueID(Visio.VisUniqueIDArgs.visGetOrMakeGUID) = pageUID Then
Set shp = pag.Shapes(shapeUID)
Set GetShape = shp
GoTo exitHere
End If
Next pag
exitHere:
Exit Function
errHandler:
'Not found
Resume exitHere
End Function
GetMasterU function
This function returns the master in the active document of the passed in master name, or nothing if it does not exist.
Public Function GetMasterU(ByVal masterName As String) As Visio.Master
If Len(masterName) = 0 Then
Exit Function
End If
Dim mst As Visio.Master
For Each mst In Visio.ActiveDocument.Masters
If UCase(mst.NameU) = UCase(masterName) Then
Set GetMasterU = mst
Exit Function
End If
Next
Set GetMasterU = Nothing
End Function
EnhanceTheOPCs function
This sub-function enhances all of the instances of the specified master
Public Sub EnhanceTheOPCs()
On Error GoTo errHandler
Const MSTR As String = "Off-page reference"
Dim mst As Visio.Master
Set mst = GetMasterU(MSTR)
If mst Is Nothing Then
GoTo exitHere
End If
Dim pag As Visio.Page
Dim sel As Visio.Selection
Dim shp As Visio.Shape
Dim trgtPageUID As String
Dim trgtShapeUID As String
Dim trgtPage As Visio.Page
Dim trgtShape As Visio.Shape
Dim chars As Visio.Characters
For Each pag In ActiveDocument.Pages
Set sel = pag.CreateSelection(visSelTypeByMaster, 0, mst)
For Each shp In sel
If shp.CellExistsU("User.OPCDPageID", Visio.VisExistsFlags.visExistsAnywhere) <> 0 Then
trgtPageUID = shp.CellsU("User.OPCDPageID").ResultStr("")
trgtShapeUID = shp.CellsU("User.OPCDShapeID").ResultStr("")
If Len(trgtPageUID) = 38 And Len(trgtShapeUID) = 38 Then
Set trgtShape = GetShape(trgtPageUID, trgtShapeUID)
If Not trgtShape Is Nothing Then
Set trgtPage = trgtShape.ContainingPage
If shp.CellExistsU("User.visEquivTitle", Visio.VisExistsFlags.visExistsAnywhere) Then
shp.CellsU("Hyperlink.OffPageConnector.SubAddress").FormulaU = "=""" & trgtPage.Name & "/" & trgtShape.Name & """"
shp.CellsU("Hyperlink.OffPageConnector.Description").FormulaU = "=User.visEquivTitle"
'Remove the existing formula =RUNADDONWARGS("OPC","/CMD=3")
shp.CellsU("TheText").FormulaU = "=0"
shp.CellsU("User.visEquivTitle.Prompt").FormulaU = "=Pages[" & trgtPage & "]!Sheet." & trgtShape.ID & "!User.visEquivTitle"
Set chars = shp.Characters
chars.Delete
chars.Begin = 0
chars.End = 1
chars.AddCustomFieldU "User.visEquivTitle.Prompt", visFmtNumGenNoUnits
End If
End If
End If
End If
Next shp
Next pag
exitHere:
Exit Sub
errHandler:
MsgBox Err.description, vbExclamation, "EnhanceTheOPCs"
Resume exitHere
End Sub
Further reading
Synchronizing Visio Shape Fill Color (or almost any cell) across pages
I was recently asked how the color of one shape can be changed and for other shapes to be automatically updated to the same color … even if they are on different pages! Well, it is possible with Microsoft Visio’s awesome ShapeSheet formulas. In fact, this capability is not limited to the FillForegnd cell ……
Positioning Visio Shape Text Block with a Control Handle
I was recently asked how a control handle can be added to a Visio shape so that it can be used to re-position the text block. Fortunately, it is extremely easy to setup, and requires just two formulas to be updated in the ShapeSheet. This is a great use of the SETATREF(…) function. (more…)
Understanding Segments of Visio Geometry
I recently had to revise my understanding of the POINTALONGPATH(…) function in Visio because I was getting a #REF! error in some cases. My particular scenario requires a line with a number of vertices that are initially all in a straight line but can be moved by dragging controls around that each vertex is bound…
Custom Color Themes in Visio?
I was recently looking into custom color themes for corporate branding in desktop Microsoft Visio and became re-aware how different Visio still is from the rest of the Microsoft Office applications. A Visio page or document does not need to have any theme applied, but the documents of the other Office applications always have a…
When is a Visio Callout not a Callout?
I have been a Visio user/developer since the mid-1990’s and seen the word “callout” used as part of the name of many master shapes in Visio. The images below show five ways that the term “callout” has been applied to the name of Visio master shapes. Generally, each evolution has been an advance on the…
Using Visio Color by Value on Connectors
Data Graphics in Visio Plan 2 and Visio Professional is great, but it only enables us to use them with 2D shapes in Visio, i.e. not on connectors. So, what if you want to change the line colour of the connectors between the 2D shapes because of the data flowing between them? Well, it is…
John says
Thank you so much for this! Is there a way to use the page number instead of the page name for this?
John says
Whoops! Figured out my problem. An existing document stencil was overwriting my OPC text when I placed a new one from my stencil group. Thank you!