Can I copy shape data between different sheets

Hi, I have been trying out the Off-page connector but this does not seem to do what I want. It has an option to synchronise "text" of a shape, but I want to synchronise shape data. My shapes on both pages would have the same shape data fields defined.

I have figured out I can move the active page pointer to another page and then reference shapes on that page. Alternatively is there a way to put the page name as an index into the reference for the shape I am interested in ? I can't seem to find syntax for this.
ie instead of;

set active page 1
global = shape data

set active page 2
shape data = global

can I say; = ?
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Scott HelmersVisio Consultant, Trainer, Author, and DeveloperCommented:
Unfortunately, "shape data" is not a single entity; each shape data field actually consists of multiple items (shapesheet cells, to be specific) that need to be copied in order to replicate that field.

Consequently. you have to loop through the shape data section, copying all the cells for each data field.

The code below should do what you want. As you'll see, both the from/to page names and the from/to shape IDs are hardcoded -- you'll need to substitute your own page names and shape IDs.

Let me know if you have any questions or want me to attach a Visio file with this code in it.
Sub Copy_Shape_Data_Page_to_Page()
' If named row already exists in TO shape, overwrites its cell values,
' otherwise creates a new row
' Does not affect shape data rows in TO shape if row names don't match
' those in the FROM shape
    Dim pgFrom As Visio.Page, pgTo As Visio.Page
    Dim shpFrom As Visio.Shape, shpTo As Visio.Shape
    Dim rowFrom As Visio.Row, rowTo As Visio.Row
    Dim ixFromRow As Integer, ixToRow As Integer
    Dim ixCol As Integer
    ' Select FROM page and shape
    Set pgFrom = ActiveDocument.Pages("Page-1")
    Set shpFrom = pgFrom.Shapes("Sheet.1")
    ' Select TO page and shape
    Set pgTo = ActiveDocument.Pages("Page-2")
    Set shpTo = pgTo.Shapes("Sheet.1")
    ' Create shape data section if it doesn't already exist
    If Not shpTo.SectionExists(visSectionProp, False) Then
        shpTo.AddSection (visSectionProp)
    End If
    For ixFromRow = 0 To shpFrom.RowCount(visSectionProp) - 1
        Set rowFrom = shpFrom.Section(visSectionProp).Row(ixFromRow)
        If shpTo.CellExists("Prop." & rowFrom.Name, False) Then
            ' Named row already exists so get its row number
            ixToRow = shpTo.CellsRowIndex("Prop." & rowFrom.Name)
            ' Row doesn't exists so create it and get its row number
            ixToRow = shpTo.AddNamedRow(visSectionProp, rowFrom.Name, visTagDefault)
        End If
        For ixCol = 0 To shpFrom.RowsCellCount(visSectionProp, ixRow) - 1
            shpTo.CellsSRC(visSectionProp, ixToRow, ixCol).FormulaForceU = _
            shpFrom.CellsSRC(visSectionProp, ixFromRow, ixCol).FormulaU
        Next ixCol
    Next ixFromRow
End Sub

Open in new window


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
adlikonAuthor Commented:
Super. I am building a stencil so I probably won't go for the 'full monty' validation to see if cells exist as users will not be creating new shapes or shape data with the macros I am creating. Cheers
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Visio

From novice to tech pro — start learning today.