PROSAGA码农传奇-visio-在宏中剪切和粘贴Visio形状

0# 夏花 | 2019-08-31 10-32

1# 生如夏花 | 2019-08-31 10-32

<div class =“post-text”itemprop =“text”>
  
    形状的ID仅对其页面是唯一的，因此粘贴到Page-1的新形状将收到一个新ID，从而收到您正在接收的错误。虽然
     <code>
 Duplicate
 </code>
     方法返回对新形状的形状引用，
     <code>
 Paste
 </code>
     不是这样你需要通过其他方式获得对它的引用 - 或者假设关于窗口选择（根据Surrogate的答案）或索引：
  
   <pre>
 <code>
 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

</code>
 </pre>
  
    更常见的工作流程是生成母版（在模板文档中）然后删除这些母版而不是在页面之间复制和粘贴，但您的场景可能需要不同的方法。
  
  
    我将添加此链接作为处理索引和ID属性的有用参考：
  
  <UL>
    <LI>
      <a href="https://docs.microsoft.com/en-us/previous-versions/office/developer/office-xp/aa201761(v%3Doffice.10)" rel="nofollow noreferrer">
        使用形状对象
      </A>
    </LI>
  </UL>
  
    [更新]
  
  
    @Jon Fournier在下面的评论是完全正确的，以上确实做出了假设。例如，如果
    <a href="https://docs.microsoft.com/en-us/office/client-developer/visio/displaylevel-cell-shape-layout-section" rel="nofollow noreferrer">
       <code>
 DisplayLevel
 </code>
    </A>
     源形状中的单元格小于最顶部的形状，然后它将粘贴到相应索引处的页面形状集合中，因此count将不会返回正确的形状ID。
  
  
    另一种方法可能是倾听
    <a href="https://docs.microsoft.com/en-us/office/vba/api/visio.pages.shapeadded" rel="nofollow noreferrer">
       <code>
 ShapeAdded
 </code>
    </A>
     页面（或页面）上的事件。以下是对此的略微改编
    <a href="https://docs.microsoft.com/en-us/office/vba/api/visio.application.isinscope" rel="nofollow noreferrer">
       <code>
 IsInScope
 </code>
    </A>
     在docs中的示例，代码放置了ThisDocument。这允许您在处理ShapeAdded事件时可以检查的事件范围ID对中对代码进行顶部和尾部处理：
  
   <pre>
 <code>
 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

</code>
 </pre>
</DIV>

2# 部落用户 | 2019-08-31 10-32