Adding Shape Data to a series of new shapes

I have been playing with Visio Visualization in Power BI and the first step is to create a Visio drawing. Basically it is a bunch of shapes, but I need to add Shape Data to the new shapes, basically the key that will link the shape to the row of data in Excel. I could select each shape and then set the shape name and create the shape data, but I am lazy, so…

Again VBA was useful.

So I used the following code to go through selected shapes, change the text on the current shape to “X” so I can see which shape I am about to change. The ShowChanges line makes the change visible.

I then prompt the user for the name they want to apply to the shape and use that to set the name of the shape. I also boost the font size so that it is more visible. I then go through and delete the shapes properties if they already exist so I can start with a clean slate. I then add the Shape Data field I will use as a key to the shape. The other fields will be added as Visio makes the data connections using the key. I then set the text for the shape to be the shape’s name.
I then deselect the shapes, so a new set of shapes can be selected.

Public Sub LoadCabins()
Dim Shpname As String
Dim vsoSelect As Visio.Selection
Dim vsoShape As Visio.Shape
Set vsoSelect = Visio.ActiveWindow.Selection
If vsoSelect.Count > 0 Then
For Each vsoShape In vsoSelect
vsoShape.Text = "X"
Application.ShowChanges = True
Shpname = InputBox("Enter the cabin number", "Cruise Line")
vsoShape.Name = Shpname
vsoShape.Cells("Char.Size").Formula = "=20 pt."
If vsoShape.CellExists("Prop.Cabin", 0) Then
vsoShape.DeleteRow visSectionProp, vsoShape.CellsU("Prop.Cabin").Row
If vsoShape.CellExists("Prop.Category", 0) Then
vsoShape.DeleteRow visSectionProp, vsoShape.CellsU("Prop.Category").Row
If vsoShape.CellExists("Prop.Type", 0) Then
vsoShape.DeleteRow visSectionProp, vsoShape.CellsU("Prop.Type").Row
If vsoShape.CellExists("Prop.Amenities", 0) Then
vsoShape.DeleteRow visSectionProp, vsoShape.CellsU("Prop.Amenities").Row
If vsoShape.CellExists("Prop.Connect", 0) Then
vsoShape.DeleteRow visSectionProp, vsoShape.CellsU("Prop.Connect").Row
iPR = vsoShape.AddRow(visSectionProp, visRowLast, visTagDefault)
vsoShape.Section(visSectionProp).Row(iPR).NameU = "Cabin"
vsoShape.CellsSRC(visSectionProp, iPR, visCustPropsLabel).FormulaU = """Cabin"""
vsoShape.CellsSRC(visSectionProp, iPR, visCustPropsType).FormulaU = "0"
vsoShape.CellsSRC(visSectionProp, iPR, visCustPropsFormat).FormulaU = ""
vsoShape.CellsSRC(vi7176sSectionProp, iPR, visCustPropsLangID).FormulaU = "4105"
vsoShape.CellsSRC(visSectionProp, iPR, visCustPropsValue).FormulaU=vsoShape.Name
Set vsoCharacters = vsoShape.Characters
vsoCharacters.Begin = 0
vsoCharacters.End = 5
vsoCharacters.AddCustomFieldU "Prop.Cabin", visFmtNumGenNoUnits
Debug.Print vsoShape.Name
Next vsoShape
MsgBox "You Must Have Something Selected"
End If
End Sub

Though this code can handle all the shapes at once, it is designed to handle smaller groups at a time. You do not want to accidently change shapes you did not intend on changing. In the process of creating the shapes, I did rerun the code several times.
So, this will help me populate a Visio drawing with data that Visio can use to link to an Excel spreadsheet and load extra data. I am in the process of writing the three articles that will explain the Visio visualization in Power BI demo I am planning on building. The first will be the creation of the Visio drawing and the considerations involved, the second will be lighting up the drawing in Visio using data connectivity and the final article will be using that Visio drawing in a Power BI dashboard.


John Marshall… Visio MVP

Published by johnvisiomvp

The original Visio MVP. I have worked with the Visio team since 1993