如何将 VISIO 文件中的对象复制到另一个文件中的相同位置

Question

我创建了一个 VBA 程序，使用 Selection.Copy 方法从一个 VISIO 文件 (A.vsdx) 复制到另一个 VISIO 文件 (B.vsdx)。

我想将它复制到与 A.vsdx 文件相同的位置，但它不起作用。它是 https://docs.microsoft.com/en-us/office/vba/api/visio.page.paste 看这个页面，visCopyPasteNoTranslate好像不错，但是没有达到预期的效果。

或者，我考虑过使用 Selection.Top 方法，但它没有用，因为 VISIO 的选择没有 Top 或 Left 方法。

伪代码如下所示

    Dim group_ As visio.Shape

    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
            ''' This code doesn't work
            Set group_ = vsoWindow_old.Selection.group
            '''
            vsoWindow_old.Selection.Copy
            
            newvsoDoc.Pages.Item(vsoPage.Name).Paste visCopyPasteNoTranslate
            
        End If
        
        vsoWindow_old.Selection.DeselectAll
    
    Next vsoPage

Answer 1

可以使用方法PasteToLocation，但必须知道X，Y-coordinates才能粘贴！

我写的代码比较仓促，为了简单起见：

两个文档都只包含一页
目标文档有空白页（无形状）

目标页面没有锁定图层[更新]

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

如何将 VISIO 文件中的对象复制到另一个文件中的相同位置

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

vba

visio