I work a lot with layers in Visio, and written an add-in, LayerManager, to assist, but I was asked an interesting question recently: How can shapes by assigned to layers automatically from a list in Excel? So, I thought I would present my solution. This particular request was for a Timeline diagram, where the Milestone shapes are to be on specific layers. So, I just used one of the samples provided with Visio.
The first part of solution is to get a list in Excel which can be used to identify the shapes, and to add a column with the desired layer name for each shape, if such a column does not exist already.
Fortunately, the Shape Reports feature in Visio can export a list of shapes to Excel. This tool can export many shape properties and any of the Shape Data that are on the shapes too.
If the report is exported to Excel, it will contain a top row with the title, then the second row contains the column headers, with all of the data below it. Fortunately, Power Query has great abilities, including promoting row values to become the column headers, and transforming text into dates. I decided to add a MonthName column to use as the names of layers in Visio.
So, I now have a table in Excel which has a column with the ID of each shape, and another column that I want to be the name of a layer that the shape needs to be assigned to.
Now I needed a VBA macro to read the active Excel table, and assign the layer to each shape in the active Visio page.
I normally but VBA code in stencils so they can be re-usable with any document. The following code also requires that the Microsoft Excel Object library.
The VBA code is offered below with minimal error trapping:
Option Explicit
Public Sub AssignLayersFromTable()
Dim title As String
title = "AssignLayersFromTable"
On Error GoTo errHandler
Dim excelApp As Excel.Application
Dim sourceWrkbk As Excel.Workbook
Dim sourceWrksht As Excel.Worksheet
Dim sourceTable As Excel.ListObject
Set excelApp = GetExcelApp()
If excelApp Is Nothing Then
GoTo exitHere
End If
Set sourceWrkbk = excelApp.ActiveWorkbook
If sourceWrkbk Is Nothing Then
GoTo exitHere
End If
Set sourceWrksht = excelApp.ActiveSheet
If sourceWrksht Is Nothing Then
GoTo exitHere
End If
Debug.Print sourceWrksht.Name
If sourceWrksht.ListObjects.Count > 0 Then
Set sourceTable = sourceWrksht.ListObjects.Item(1)
End If
Dim listCol As ListColumn
Dim listRow As listRow
Dim msg As String
If Not sourceTable Is Nothing Then
Debug.Print sourceTable.Name
msg = ""
For Each listCol In sourceTable.ListColumns
msg = msg & vbCrLf & listCol.Index & vbTab & listCol.Name
Debug.Print listCol.Index, listCol.Name
Next
Dim retValue As Variant
Dim colShape As Integer
Dim colLayer As Integer
retValue = InputBox(msg, "Enter the number of the shape ID column")
If Not IsNumeric(retValue) Then
MsgBox "Sorry, that was not a number", vbExclamation, title
GoTo exitHere
End If
colShape = CInt(retValue)
If colShape < 1 Or colShape > sourceTable.ListColumns.Count Then
MsgBox "Sorry, the number must be in the range", vbExclamation, title
GoTo exitHere
End If
retValue = InputBox(msg, "Enter the number of the layer name column")
If Not IsNumeric(retValue) Then
MsgBox "Sorry, that was not a number", vbExclamation, title
GoTo exitHere
End If
colLayer = CInt(retValue)
If colLayer < 1 Or colLayer > sourceTable.ListColumns.Count Then
MsgBox "Sorry, the number must be in the range", vbExclamation, title
GoTo exitHere
End If
Dim shp As Visio.Shape
Dim iLyr As Integer
Dim lyr As Visio.Layer
For Each listRow In sourceTable.ListRows
Set shp = ActivePage.Shapes.ItemFromID(listRow.Range(1, colShape))
If Not LayerExists(ActivePage, listRow.Range(1, colLayer).Value) Then
ActivePage.Layers.Add listRow.Range(1, colLayer).Value
End If
'Remove all assigned layers
For i = shp.LayerCount To 1 Step -1
Set lyr = shp.Layer(i)
lyr.Remove shp, 0
Next
Set lyr = ActivePage.Layers(listRow.Range(1, colLayer).Value)
'Assign to the desired layer
lyr.Add shp, 0
Next
End If
exitHere:
Set sourceTable = Nothing
Set sourceWrksht = Nothing
Set sourceWrkbk = Nothing
Set excelApp = Nothing
Exit Sub
errHandler:
MsgBox Err.Description, vbCritical, "AssignLayersFromTable"
Resume exitHere
End Sub
Private Function IsOnLayer(ByVal shp As Visio.Shape, ByVal lyrName As String)
End Function
Private Function LayerExists(ByVal pag As Visio.Page, lyrName As String) As Boolean
Dim lyr As Visio.Layer
For Each lyr In pag.Layers
If lyr.Name = lyrName Or lyr.NameU = lyrName Then
LayerExists = True
End If
Next
LayerExists = False
End Function
Private Function GetExcelApp() As Excel.Application
On Error Resume Next
Set GetExcelApp = GetObject(, "Excel.Application")
End Function
I hope this helps….
Layer Set menu options and calls from code added to LayerManager
LayerManager for Microsoft Visio layer sets can now be called from external code and are also available from a sub-menu of the Layer Buttons drop-down ribbon button. The Layer Manager window does not need to be open to use the sub-menu because it detects the Layer Set buttons on the page. (more…)
Update to LayerManager add-in for non-English users
A French user of LayerManager recently reported that the Refresh Counts button was not working for him, and a few other users were recently finding that the trial period was reporting expired immediately after download. Both of these issues have hopefully been addressed in the latest version 23.3.1, which is available for free to current…
Pushing Data Visualizer in Visio to the limits!
Regular readers of my blog will know that I like to use the Data Visualizer (DV) in Visio Plan 2, but I recently tried to help a user who really decided to push it to the limits. In this scenario, there were multiple connections, but with different labels, being created between the same flowchart shapes,…
Editing Visio Layer Colours with LayerManager
Desktop Visio has a tremendous ability to assign shapes to none, one or more layers, and the efficient use of them can make a drawing so powerful by toggling layers visibility or locking certain layers whilst working on other layers. The same drawing can be used, displayed or printed for many different purposes just by…
Fixing the sub-shape layer assignments of Visio shapes
I was preparing a new update of my Layer Manager tool, and was constantly coming across a lack of quality control in the sub-shape layer assignment in a number of the master shapes in Microsoft provided stencils. I have mentioned this to Microsoft as a bug before but the problem still persists in Visio for…
Developer Mode for advanced Layer Manager actions
I have had more than one person ask me how to see the full Layer Manager panel, so I must have not made it clear enough in the help file. Visio has a Developer Mode that is simple to switch on, and provides some extra functionality, including a Developer tab in the ribbon. Layer Manager…