剪切并粘贴宏中的Visio形状

Question

我正在尝试编写一个VBA宏，该宏根据数据和某些模板形状(保存在单独的页面上)构建基本关系图。虽然我可以成功地剪切和粘贴，但在我这样做之后，我似乎无法参考新的形状。在剪切和粘贴形状之前，我可以重新定位它，但如果我在之后尝试做任何事情，我会遇到运行时错误。稍后可能需要移动/更新对象的原因多种多样，因此我需要能够随后引用它们。

我的代码如下：

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"

如果我运行以上操作，我会在高亮显示的行处得到错误"无效的图纸标识符"(形状粘贴成功)。如果我删掉这一行，我会在下一行得到"发生了异常"，所以看起来我失去了对对象的引用。

Answer 1

形状的ID仅对其页面唯一，因此粘贴到page-1中的新形状将收到一个新ID，从而收到错误。尽管Duplicate方法返回对新形状的形状引用，但Paste不返回，因此您需要通过其他方式获得对它的引用-假设窗口选择(根据Surrogate的答案)或通过索引：

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

更常见的工作流程是生成母版(在模具文档中)，然后删除这些母版，而不是在页面之间复制和粘贴，但您的场景可能需要不同的方法。

我将添加此链接作为处理索引和ID属性的有用参考：

• 使用形状对象

[更新]

@Jon Fournier在下面的评论是非常正确的，上面确实做出了假设。例如，如果源形状中的DisplayLevel单元格小于最顶部的形状，则它将被粘贴到相应索引处的页面形状集合中，因此count不会返回正确的形状ID。

另一种方法可能是侦听Pages(或Page)上的ShapeAdded事件。以下是对文档中IsInScope示例的轻微修改，代码放在ThisDocument中。这允许您在处理ShapeAdded事件时检查的事件范围ID对中对代码进行顶部和尾部处理：

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

当然会出现错误"无效的工作表标识符"！因为在"Page-1"中，您可以使用ShapeID创建形状，该形状是您为放置在"Page-2"中的形状定义的。

您可以粘贴形状，然后在此步骤之后定义选定的形状。

Application.ActiveDocument.Pages.ItemU("Page-1").Paste
' You can define this variable as shape which is selected
Set Shape = Application.ActiveWindow.Selection.PrimaryItem

为什么要使用变量两次？

Answer 3

我还没有找到处理这个问题的好方法。我有一个方法可以将剪贴板粘贴到页面并返回任何新形状，方法是在粘贴前后列出所有形状ID，然后返回新形状。

如果速度对我来说是个大问题，我通常会粘贴到一个空的隐藏页面，在该页面上做任何我必须做的事情，然后剪切并粘贴到目标页面上。如果你需要与其他形状粘合，这不会真正起作用，但当它有意义时，我会使用这个逻辑。

Answer 4

而不是重复&剪切&粘贴，只需使用Drop:

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

完成以上操作后，您可以访问dstShape并使用它进行任何操作。