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 tat 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. 10 Comments »

10 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


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 204 other followers

%d bloggers like this: