Author Topic: Macro Visio 2010 does not work in Visio 2013  (Read 345 times)

0 Members and 1 Guest are viewing this topic.

willdthrill

  • Newbie
  • *
  • Posts: 2
Macro Visio 2010 does not work in Visio 2013
« on: June 27, 2018, 02:01:45 PM »
Hello - just upgraded from Visio 2010 to Visio 2013.  The following macro now fails (Run-time error -2032465751 (86db08a9).

The below updates all the off sheet reference shape's DESTINATION SHEET shape data to the current linked page.

Sub FixOffPageReferences()

Dim OPCDShapeID As String
Dim OPCDPageName As String
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  <---fails here
                                        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."

End Sub

Thanks!