Cut and paste Visio shape in macro

Question

I'm trying to write a VBA macro that builds a basic diagram from data and certain template shapes (held on a separate page). While I can cut and paste successfully, I seem to be unable to reference the new shape after I do this. I can relocate the shape before I cut and paste it, but if I try to do anything after the fact, I hit a run-time error. There are various reasons why I might need to move / update the objects later, so I need to be able to subsequently reference them.

My code is as follows:

Dim Shape as Visio.Shape
Dim ShapeID as Integer
 
‘copy shape from template page 2, ID 12
Set Shape = Application.ActiveDocument.Pages.ItemU("Page-2").Shapes.ItemFromID(12).Duplicate
 
ShapeID = Shape.ID
MsgBox ("Created shape ID: " & ShapeID)
      
'Now relocate the shape appropriately
currentX = startX + (Count * xSpacing)
currentY = startY
       
Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaForceU = "" & currentX & " mm"
Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaForceU = "" & currentY & " mm"
 
Shape.Cut
   
 'Now go to page 1 and paste the object
 
Application.ActiveDocument.Pages.ItemU("Page-1").Paste

‘*** THE FOLLOWING LINE THAT DOESN’T WORK ***
Set Shape = Application.ActiveDocument.Pages.ItemU("Page-1").Shapes.ItemFromID(ShapeID)
 
Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaForceU = "" & currentX & " mm"
Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaForceU = "" & currentY & " mm"

If I run the above, I get the error "Invalid sheet identifier" at the highlighted line (the shape is pasted successfully). If I cut this line out, I get "an exception occurred" on the following line, so it looks like I've lost my reference to the object.

Answer 1

A shape's ID is only unique to its page, so the new shape that you paste into Page-1 will receive a new ID and hence the error that you're receiving. Although the Duplicate method returns a shape reference to the new shape, Paste does not so you need to get a reference to it by other means - either assuming something about the window selection (as per Surrogate's answer) or by index:

Dim shp As Visio.Shape
Dim pag As Visio.Page

Set pag = ActivePage 'or some alternative reference to Page-1
Set shp = pag.Shapes.ItemU(pag.Shapes.Count)
Debug.Print shp.Index

A more usual workflow would be to generate masters (in a stencil document) and then drop those masters rather than copying and pasting between pages, but your scenario may require a different approach.

I'll add this link as useful reference for dealing with Index and ID properties:

• Working with Shape Objects

[Update]

@Jon Fournier's comment below is quite right that the above does make assumptions. For example, if the DisplayLevel cell in the source shape is less than the top most shape then it will be pasted into the page's shapes collection at the corresponding index and so count won't return the correct shape ID.

An alternative approach might be to listen to the ShapeAdded event on Pages (or Page). The following is a slight adaption from the IsInScope example in the docs, with code placed ThisDocument. This allows you to top and tail your code in an event scope ID pair that you can inspect when handling the ShapeAdded event:

Private WithEvents vPags As Visio.Pages
Private pastedScopeID As Long

Public Sub TestCopyAndPaste()

    Dim vDoc As Visio.Document
    Set vDoc = Me 'assumes code is in ThisDocument class module, but change as required

    Dim srcPag As Visio.Page
    Set srcPag = vDoc.Pages.ItemU("Page-2")

    Dim targetPag As Visio.Page
    Set targetPag = vDoc.Pages.ItemU("Page-1")

    Dim srcShp As Visio.Shape
    Set srcShp = srcPag.Shapes.ItemFromID(12)

    Set vPags = vDoc.Pages

    pastedScopeID = Application.BeginUndoScope("Paste to page")

    srcShp.Copy
    targetPag.Paste

    Application.EndUndoScope pastedScopeID, True

End Sub

Private Sub vPags_ShapeAdded(ByVal shp As IVShape)
    If shp.Application.IsInScope(pastedScopeID) Then
        Debug.Print "Application.CurrentScope " & Application.CurrentScope
        Debug.Print "ShapeAdded - " & shp.NameID & " on page " & shp.ContainingPage.Name
        DoSomethingToPastedShape shp
    Else
        Debug.Print "Application.CurrentScope " & Application.CurrentScope
    End If
End Sub

Private Sub DoSomethingToPastedShape(ByVal shp As Visio.Shape)
    If Not shp Is Nothing Then
        shp.CellsU("FillForegnd").FormulaU = "=RGB(200, 30, 30)"
    End If
End Sub

Answer 2

Of course you get error "Invalid sheet identifier" ! Because at "Page-1" you can have shape with ShapeID, which you defined for shape placed at "Page-2".

You can paste shape and after this step define selected shape.

Application.ActiveDocument.Pages.ItemU("Page-1").Paste

' You can define this variable as shape which is selected
Set Shape = Application.ActiveWindow.Selection.PrimaryItem

Why you use variable two times ?

Answer 3

I haven’t found a great way to handle this. I have a method that will paste the clipboard to a page and return any new shapes, by listing all shape ids before and after pasting, and then returning new shapes.

If speed is a big issue for me I’ll usually paste to an empty hidden page, do whatever I have to on that page, then cut and paste in place on the destination page. If you need to glue with other shapes this wouldn’t really work, but when it makes sense I use this logic.

Answer 4

Instead of Duplicate&Cut&Paste, just use Drop:

Dim srcShape, dstShape as Shape
Set srcShape = ActiveDocument.Pages("Page-2").Shapes("srcShape")
Set dstShape = ActiveDocument.Pages("Page-1").Drop(srcShape, 0, 0)

After the above you can access dstShape and do with it whatever you want.