宏以更新Visio OPCDPageID

时间:2018-10-04 22:09:23

标签: visio-vba

我们最近从Visio 2010迁移到Visio 2013,并且更新OPC的宏现在失败“无效的参数”。请参阅所附图片。我知道这一行正在查找目标OPC的结果是否不等于Sheet.0,如果不等于,则使SecondPageName等于目标OPC表单的名称。

有人可以传递无效参数吗?

Sub FixOffPageReferences()

将OPCDShapeID设置为字符串 昏暗的OPCDPageName作为字符串 Dim pag2 As Visio.Page

For Each pag In Application.ActiveDocument.Pages
    'Only the foreground pages
    If pag.Type = visTypeForeground Then
        'Loop through all shapes in page

        For Each shp In pag.Shapes
            'Make sure shape exists (Script crashes if it tries to read data that doesn't exist)
            If shp.CellExists("Prop.Row_1", 0) Then
                deviceType = shp.Cells("Prop.Row_1.Label").ResultStr(visNoCast)
                If deviceType = "DESTINATION SHEET" Then
                    OPCShapeID = shp.Cells("User.OPCShapeID").ResultStr(visNoCast)
                    OPCDShapeID = shp.Cells("User.OPCDShapeID").ResultStr(visNoCast)

                    'make sure the OPC is connected to a destination shape on another sheet
                    If OPCDShapeID <> "" Then
                        For Each pag2 In Application.ActiveDocument.Pages
                            If pag2.Type = visTypeForeground Then
                                If pag2.Shapes.ItemFromUniqueID(OPCDShapeID).Name <> "Sheet.0" Then
                                    SecondPageName = pag2.Name
                                    pag2.Shapes(OPCDShapeID).Cells("User.OPCDPageID").Formula = Chr(34) & pag.PageSheet.UniqueID(visGetOrMakeGUID) & Chr(34)
                                    Exit For
                                End If
                            End If
                        Next
                    End If
                    shp.CellsSRC(visSectionHyperlink, 0, visHLinkSubAddress).FormulaU = Chr(34) & SecondPageName & Chr(34)
                    On Error Resume Next
                    shp.Cells("Prop.Row_1").FormulaU = "=Guard(Hyperlink.OffPageConnector.SubAddress)"
                    On Error GoTo 0
                End If
            End If
        Next
    End If
Next

MsgBox "All Sheet numbers on off-sheet references have been updated."

结束子 谢谢!

code

0 个答案:

没有答案