Copying Data from one Shape to Another

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.

image

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.

image

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:

  1. CopyAllFromConnectedSourceToTargets
  2. CopyAllFromSelectedSourceToTargets
  3. CopyFromSelectedSourceToTargets

CopyAllFromConnectedSourceToTargets

I simply drew an ellipse then connected the Server shape to the ellipse with a connector.

image

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.

image

Now, the target ellipse shape has ll of the data that is on the source Server shape.

image

CopyAllFromSelectedSourceToTargets

Strangely, the Rack Mounted Server shapes in Visio Professional 2007 do not have ay Shape Data rows.

image

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.

image

Again, the target shapes will have all of the data rows copied across.

image

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.

image

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.

image

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.

image

This time, the target shapes will have the shared data rows copied across.

image

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

Posted in Visio. 12 Comments »

12 Responses to “Copying Data from one Shape to Another”

  1. Nick Says:

    Hi David,

    Extremely useful tool! Any idea how you could modify this code to allow a dropped shape from a stencil to pick up shape data from a shape that the dropped shape lands on.

    for example a cow shape (from the stencil) is placed on a field shape that exists on the drawing already. When this happens the Cow inherits the field ID number.

    Something to bear in mind might be that the cow can change fields as the drawing is modified.

    Regards,
    Nick B

  2. Which field is that cow in? | bVisual Says:

    […] 2011 by davidjpp I reader of one of my earlier posts, Copy Data from one Shape to Another ( see http://davidjpp.wordpress.com/2009/02/02/copying-data-from-one-shape-to-another/ ) asked how a cow can inherit the field number of from the field that it in. I think that this is […]

  3. Outline Visio Shapes – Part1 « Visio Drawing Ninja Says:

    […] One of the best ways to lean how various shapes are made is to simply apply the “Ungroup” tool. Visio will warn that the shape will become separated from the master shape, just keep going and all the sub-shapes that make up the master shape can be individually examined. Note that if there is shape data fields in the shape these are destroyed in the process un-grouping. There is a great blog from David Parker on creating a macro to fix this. […]

  4. Tracy Black Says:

    Hi David,
    I’m a heavy user of Visio 2010 and SharePoint on Windows 7 but admit I am a novice at Visual Basic. Your book and blogs have been quite helpful but I’ve hit a snag here. I’m attempting to use CopyAllFromSelectedSourceToTargets but keep getting a compile – syntax error on line 189 under Public Function SetTargetData. Is there anything you can suggest to help me out?

    • davidjpp Says:

      The only references are:
      Visual Basic For Applications
      Microsoft Visio 14.0 Type Library
      OLE Automation
      Microsoft Office 14.0 Object Library

      Did you download the file or copy and paste the code (the latter could have split the code lines in strange places) ?

      • Tracy Black Says:

        Thanks, David. The answer to your question is copy and paste. Due to web restrictions in the office I wasn’t able to download the code initially. That’s been rectified, and I’m good to go now.
        Being out of my element, I must have had a case of not seeing the forest for the trees! I assumed the mistake was mine and, in the process, overlooked the most obvious possibility! Thank you again.

  5. Satkay Satish Says:

    Fantastic worked for me. (y)

  6. AW Says:

    Hi David,

    this is almost solving my problem, but I have no experience with VBA so I can’t solve it by myself.

    What I want to do is: I have a server rack with diverse patch panels. Every Patchpanelport has shapedata.

    Now I connect two Ports with a connector, and the connector should collect the shapedata of the beginport and the endport.

    Can you help me?

    Best regards,

    AW

  7. Dave Says:

    Will these scripts work with visio 2013? I tried the copy paste, but ended up with a great many syntax errors.
    thanks

    • davidjpp Says:

      They do work, however I have found some issues in copy and paste from this website.
      I replace the ‘ with a ‘ and – with – …. then everything compiles … or download the file provided.


Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

Join 298 other followers

%d bloggers like this: