A recent newsgroup question asked for example code to demonstrate how shape data can be copied from one shape to another via a connector between the two. This is something that others might want to do also, and not just by connecting shapes, but also by selection since you might change your mind about which shape to use, but you have already entered a lot of information on the original shape. A good example of this might be when diagramming a network and needing to change between one type of server and another. So, in this blog, I will demonstrate how shape data can be transferred by connection or by selection, and how to limit the transfer to rows that match by name or by label.
Note that Shape Data is the new name for Custom Properties in Visio 2007.
Firstly, I should explain why it may be necessary to match by name or by label: In the following screenshot, you can see the Shape Data window, Define Shape Data dialog, and the ShapeSheet for a Server shape. I have ticked “Run in developer mode” in Tools / Options / Advanced, otherwise I would not be able to see the Name, Sort key, Ask on drop or Hidden in the dialog.
A non-developer may use the Define Shape Data dialog without switching on developer mode, and thus will be oblivious to the name of the row. In this case, Visio will assign a unique name itself in the format Row_n, where n is a number. This type of user just uses the Label to identify the row visually, and because of this, Microsoft decided to make the Link Data to Shapes… tool in Visio 2007 Professional use the Label to match rows. However, this tool does not leave the row name in its default format, but renames it with a _VisDM_ prefix followed by a sanitised version of the Label (without spaces and special characters). The following screenshot is from one of the sample diagrams in Visio 2007 Professional where you can see that the last four rows were added by the Link Data to Shapes…. tool.
Coincidently, this example also shows a downside to this approach because the shape already had a row named CPU, with a label “CPU”, and the data set contained a column labelled “CPU (MHz)”, which became a row named _VisDM_CP_MHz. These are probably meant to be the same, and I have dealt with this issue in my book Visualizing Information with Microsoft Office Visio 2007.
Other Visio tools, such as the Database Wizard, only use the name of the row to match on. Therefore, it is necessary to be able to match by either row name or label.
The approach that I have taken in my code is gather the required cell formulae from the source shape, using a function called GetSourceData, then to copy this data, with qualifications, to target shapes, using a function called SetTargetData.
I have provided three example subs that call these functions:
- CopyAllFromConnectedSourceToTargets
- CopyAllFromSelectedSourceToTargets
- CopyFromSelectedSourceToTargets
CopyAllFromConnectedSourceToTargets
I simply drew an ellipse then connected the Server shape to the ellipse with a connector.
You need to select one or more connectors before running the CopyAllFromConnectedSourceToTargets macro. The macro will report back whether the data has been successfully transferred or not.
Now, the target ellipse shape has ll of the data that is on the source Server shape.
CopyAllFromSelectedSourceToTargets
Strangely, the Rack Mounted Server shapes in Visio Professional 2007 do not have ay Shape Data rows.
You need to first select the source Server shape, then any number of target shapes, before running the CopyAllFromSelectedSourceToTargets macro. The macro will report back whether the data has been successfully transferred or not.
Again, the target shapes will have all of the data rows copied across.
CopyFromSelectedSourceToTargets
In the situation were the target shapes already have ay Shape Data rows, but not the values, you may not want to transfer the superfluous data rows from the source to the target.
In this example, the Server shape has a CPU, Memory, Operating System and Hard Drive Capacity rows which are not required on the Printer shape.
As before, you need to first select the source Server shape, then any number of target shapes, before running the CopyFromSelectedSourceToTargets macro. The macro will report back whether the data has been successfully transferred or not. Note that the Shape Data window only displays common rows when multiple shapes are selected.
This time, the target shapes will have the shared data rows copied across.
Code Listings
This code is an example of what can done, but you may need to add more error detection for your own requirements.
The aficionados amongst you may spot that I am not using GetFormulas or SetFormulas methods in the following code. This is because I need to get the row name, which is not available in either method.
Option Explicit
‘Author : David Parker, Microsoft MVP (Visio)
‘Date : 2nd Feb 2009
‘Purpose: Demonstrate how shape data can be transferred from one shape to another
Public Sub CopyAllFromConnectedSourceToTargets()
‘Transfer data rows from the connected shape at the start of a connector to the connected shape at the end
If Visio.ActiveWindow.Selection.Count = 0 Then
Exit Sub
End If
Const allCells As Boolean = False
Const forceAdd As Boolean = True
Const matchByName As Boolean = True
Const matchByLabel As Boolean = True
Dim vSource As Variant
Dim cnx As Visio.Connect
Dim shp As Visio.Shape
Dim toShape As Visio.Shape
Dim fromShape As Visio.Shape
For Each shp In Visio.ActiveWindow.Selection
Set toShape = Nothing
Set fromShape = Nothing
‘Test if there are connected shapes at either end
For Each cnx In shp.Connects
If cnx.FromCell.Name = “BeginX” Then
Set fromShape = cnx.ToSheet
ElseIf cnx.FromCell.Name = “EndX” Then
Set toShape = cnx.ToSheet
End If
Next cnx
‘Now tranfer data f a source and target were found
If Not toShape Is Nothing And Not fromShape Is Nothing Then
vSource = GetSourceData(fromShape, allCells)
If SetTargetData(toShape, allCells, forceAdd, matchByName, matchByLabel, vSource) Then
MsgBox “Data successfully transferred to ” & toShape.Name
Else
MsgBox “Data failed to transfer to ” & toShape.Name
End If
End If
Next shp
End Sub
Public Sub CopyAllFromSelectedSourceToTargets()
‘Transfer all data rows from the primary selected shape to all other selected shapes
If Visio.ActiveWindow.Selection.Count = 0 Then
Exit Sub
End If
Const allCells As Boolean = True
Const forceAdd As Boolean = True
Const matchByName As Boolean = True
Const matchByLabel As Boolean = True
Dim vSource As Variant
vSource = GetSourceData(Visio.ActiveWindow.Selection.PrimaryItem, allCells)
Dim shp As Visio.Shape
Dim iShp As Integer
For iShp = 2 To Visio.ActiveWindow.Selection.Count
Set shp = Visio.ActiveWindow.Selection.Item(iShp)
If SetTargetData(shp, allCells, forceAdd, matchByName, matchByLabel, vSource) Then
MsgBox “Data successfully transferred to ” & shp.Name
Else
MsgBox “Data failed to transfer to ” & shp.Name
End If
Next iShp
End Sub
Public Sub CopyFromSelectedSourceToTargets()
‘Transfer matching data rows from the primary selected shape to all other selected shapes
If Visio.ActiveWindow.Selection.Count = 0 Then
Exit Sub
End If
Const allCells As Boolean = False
Const forceAdd As Boolean = False
Const matchByName As Boolean = True
Const matchByLabel As Boolean = True
Dim vSource As Variant
vSource = GetSourceData(Visio.ActiveWindow.Selection.PrimaryItem, allCells)
Dim shp As Visio.Shape
Dim iShp As Integer
For iShp = 2 To Visio.ActiveWindow.Selection.Count
Set shp = Visio.ActiveWindow.Selection.Item(iShp)
If SetTargetData(shp, allCells, forceAdd, matchByName, matchByLabel, vSource) Then
MsgBox “Data successfully transferred to ” & shp.Name
Else
MsgBox “Data failed to transfer to ” & shp.Name
End If
Next iShp
End Sub
Public Function GetSourceData(ByVal shp As Visio.Shape, ByVal allCells As Boolean) As Variant
‘Get the data from a shape, optionally getting all cells
On Error GoTo errHandler
Dim iRows As Integer
iRows = shp.RowCount(Visio.VisSectionIndices.visSectionProp)
If iRows = 0 Then
GetSourceData = Nothing
Exit Function
End If
Dim iCellsPerRow As Integer
If allCells Then
iCellsPerRow = 11
Else
iCellsPerRow = 3
End If
ReDim avarFormulaArray(1 To (iRows * iCellsPerRow)) As Variant
Dim iRow As Integer
Dim iCellPerRow As Integer
Dim iCell As Integer
For iRow = 0 To iRows – 1
For iCellPerRow = 1 To iCellsPerRow
iCell = (iRow * iCellsPerRow) + 1
avarFormulaArray(iCell) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsValue).RowNameU
avarFormulaArray(iCell + 1) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsLabel).FormulaU
avarFormulaArray(iCell + 2) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsValue).FormulaU
If allCells Then
avarFormulaArray(iCell + 3) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsPrompt).FormulaU
avarFormulaArray(iCell + 4) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsType).FormulaU
avarFormulaArray(iCell + 5) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsFormat).FormulaU
avarFormulaArray(iCell + 6) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsSortKey).FormulaU
avarFormulaArray(iCell + 7) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsInvis).FormulaU
avarFormulaArray(iCell + 8) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsAsk).FormulaU
avarFormulaArray(iCell + 9) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsLangID).FormulaU
avarFormulaArray(iCell + 10) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsCalendar).FormulaU
End If
Next iCellPerRow
Next iRow
GetSourceData = avarFormulaArray
exitHere:
Exit Function
errHandler:
MsgBox Err.Description, vbCritical, “GetSourceData”
Resume exitHere
End Function
Public Function SetTargetData(ByVal shp As Visio.Shape, ByVal allCells As Boolean, _
ByVal forceAdd As Boolean, ByVal matchByName As Boolean, ByVal matchByLabel As Boolean, _
ByVal aryData As Variant) As Boolean
‘Set the data on surce shape, optionally copying all cells, forcing an add, matching by row name or label
On Error GoTo errHandler
Dim iCellsPerRow As Integer
If allCells Then
iCellsPerRow = 11
Else
iCellsPerRow = 3
End If
Dim totalCells As Integer
totalCells = UBound(aryData)
If totalCells = 0 Then
SetTargetData = False
Exit Function
End If
Dim iRows As Integer
iRows = shp.RowCount(Visio.VisSectionIndices.visSectionProp)
If shp.SectionExists(Visio.VisSectionIndices.visSectionProp, Visio.VisExistsFlags.visExistsAnywhere) = False Then
shp.AddSection Visio.VisSectionIndices.visSectionProp
End If
Dim iRowsAddedToTarget As Integer
Dim iRowTarget As Integer
Dim iRow As Integer
Dim iCell As Integer
Dim rowName As String
Dim rowLabel As String
Dim iRowTest As Integer
For iRow = 1 To totalCells Step iCellsPerRow
iRowTarget = -1
rowName = aryData(iRow)
rowLabel = aryData(iRow + 1)
If matchByName Then
‘Firstly, test if row name exists
If Not shp.CellExistsU(“Prop.” & rowName, Visio.visExistsAnywhere) = 0 Then
iRowTarget = shp.CellsU(“Prop.” & rowName).Row
End If
End If
If iRowTarget < 0 And matchByLabel Then
‘Secondly, test if label exists
For iRowTest = 0 To shp.RowCount(Visio.VisSectionIndices.visSectionProp) – 1
If UCase(shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRowTest, Visio.VisCellIndices.visCustPropsLabel).ResultStr(“”)) = UCase(rowLabel) Then
iRowTarget = iRowTest
Exit For
End If
Next iRowTest
End If
If forceAdd And iRowTarget < 0 Then
If matchByName Then
iRowTarget = shp.AddNamedRow(Visio.VisSectionIndices.visSectionProp, rowName, 0)
Else
iRowTarget = shp.AddRow(Visio.VisSectionIndices.visSectionProp, shp.RowCount(Visio.VisSectionIndices.visSectionProp), 0)
End If
End If
If iRowTarget > -1 Then
setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsLabel, aryData(iRow + 1)
setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsValue, aryData(iRow + 2)
If allCells Then
setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsPrompt, aryData(iRow + 3)
setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsType, aryData(iRow + 4)
setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsFormat, aryData(iRow + 5)
setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsSortKey, aryData(iRow + 6)
setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsInvis, aryData(iRow + 7)
setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsAsk, aryData(iRow + 8)
setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsLangID, aryData(iRow + 9)
setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsCalendar, aryData(iRow + 10)
End If
End If
Next iRow
SetTargetData = True
exitHere:
Exit Function
errHandler:
MsgBox Err.Description, vbCritical, “SetTargetData”
Resume exitHere
End Function
Private Sub setCellFormula(ByVal shp As Visio.Shape, _
ByVal iSect As Integer, ByVal iRow As Integer, ByVal iCell As Integer, _
ByVal formula As String)
‘Transfer cell formula if different
If Not shp.CellsSRC(iSect, iRow, iCell).FormulaU = formula Then
shp.CellsSRC(iSect, iRow, iCell).FormulaForceU = formula
End If
End Sub
Alternatively, you can download the code from : CopyingShapeData.vsd