How to copy objects from a VISIO file to the same location in another file-CodePudding

I created a VBA program to copy from one VISIO file (A.vsdx) to another VISIO file (B.vsdx) using the Selection.Copy method.

I want to copy it to the same location as the A.vsdx file, but it doesn't work. It was https://docs.microsoft.com/en-us/office/vba/api/visio.page.paste Looking at this page, visCopyPasteNoTranslate seems to be good, but it didn't work as expected.

Alternatively, I considered using the Selection.Top method, but it didn't work because VISIO's Selection doesn't have a Top or Left method.

The pseudo code is shown below.

    For Each vsoPage In vsoDoc.Pages
        vsoWindow_old.Page = vsoDoc.Pages.ItemU(vsoPage.NameU)
        vsoWindow_new.Page = newvsoDoc.Pages.ItemU(vsoPage.NameU)
                
        For Each vsoShape In vsoPage.Shapes
            vsoWindow_old.Selection.Select vsoShape, visSelect
        Next vsoShape
        
        If Not (vsoWindow_old.Selection Is Nothing) Then
            vsoWindow_old.Selection.Copy
            
            newvsoDoc.Pages.Item(vsoPage.Name).Paste visCopyPasteNoTranslate
            
            'didn't work
            'old_SelectionTop = vsoWindow_old.Selection.BoundingBox
            'old_SelectionLeft = vsoWindow_old.Selection.Left
            
            'vsoWindow_new.Selection.Top = old_SelectionTop
            'vsoWindow_new.Selection.Left = old_SelectionLeft
             
        End If
        
        vsoWindow_old.Selection.DeselectAll
    
    Next vsoPage

CodePudding user response：

You can use method PasteToLocation, but you must know X,Y-coordinates for paste!

I wrote the code hastily, for a simplified case:

both documents contain only single page
the target document has a blank page (no shapes)

target page have not locked layers [updated]

Sub For_user18616709()
Dim s_d As Document ' source document
Dim t_d As Document ' target document
Dim s_p As Page ' source document
Dim t_p As Page ' target document
Dim gr As Shape ' temprery shape for copy
Dim sl As Selection ' Selection
Dim shs As Shape ' temprery shape after paste
Dim xp As Double, yp As Double ' X, Y coordinates
Set s_d = ActiveDocument ' define source doc
Set s_p = s_d.Pages(1) ' define source page
Set t_d = Documents(2) ' define target doc
ActiveWindow.SelectAll ' Select all shapes at source page
Set sl = ActiveWindow.Selection ' define sl
Set gr = sl.Group ' define temprery shape for copy
xp = gr.Cells("PinX") ' define X-coordinate of temprery shape
yp = gr.Cells("PinY") ' define Y-coordinate of temprery shape
gr.Copy ' copy to clipboard temprery shape for copy
gr.Ungroup ' destroy temprery shape for copy
Set t_p = t_d.Pages(1) ' define target page
t_p.PasteToLocation xp, yp, 0 ' paste to target page with location
Set shs = t_p.Shapes(1) ' define temprery shape after paste
shs.Ungroup ' destroy temprery shape after paste
End Sub