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却没有，因此您需要通过其他方式获得对它的引用-要么假设有关窗口选择（根据代理的回答）或按索引：

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属性的有用参考：

Working with Shape Objects

[更新]

@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

当然，您会收到错误“无效的工作表标识符”！因为在“页面1”中，您可以使用 ShapeID 来创建形状，该形状是您为放置在“页面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：

，而不是Duplicate＆Cut＆Paste。

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

完成上述操作后，您可以访问dstShape并随心所欲地对其进行处理。

在宏中剪切并粘贴Visio形状

4 个答案: