Select shape in Visio based on value in Excel table

Question

I've got a list of Visio shape ID's in an Excel table. When I click on a shape ID in Excel, I want Visio (simulataneously open) to select the shape with that ID.

I have repurposed some code from someone else that opens Excel and allows modifications from Visio, but now it's going in the other direction. So that's the first issue...maybe calling Visio as an object is a little different from Excel.

The code isn't throwing any errors, it just doesn't select the shape.

The second possibility is that my syntax for the Select in Visio is wrong.

Public Sub GetVisio(shapeID)
    Dim MyVSO As Object    ' Variable to hold reference
                                ' to Microsoft Visio.
    Dim VisioWasNotRunning As Boolean    ' Flag for final release.

' Test to see if there is a copy of Microsoft Visio already running.
    On Error Resume Next    ' Defer error trapping.
' Getobject function called without the first argument returns a
' reference to an instance of the application. If the application isn't
' running, an error occurs.
    Set MyVSO = GetObject(, "Visio.Application")
    If Err.Number <> 0 Then VisioWasNotRunning = True
    Err.Clear    ' Clear Err object in case error occurred.

' Check for Microsoft Visio. If Microsoft Visio is running,
' enter it into the Running Object table.
    DetectVisio

' Set the object variable to reference the file you want to see.
    Set MyVSO = GetObject("I:\XL-Projekte\0PMO-Projekte\PMO.0023 - LN+\01 PMO\07_Prozess\LNplus_Sollprozess_PMO.vsd")

' Show Microsoft Visio through its Application property. Then
' show the actual window containing the file using the Windows
' collection of the MyVSO object reference.
    MyVSO.Application.Visible = True
    MyVSO.Parent.Windows(1).Visible = True
    ' Do manipulations of your file here.

    If shapeID > 0 Then

        intShapeID = CInt(shapeID)
        Debug.Print intShapeID
        MyVSO.ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(intShapeID), visSelect

    End If

' If this copy of Microsoft Visio was not running when you
' started, close it using the Application property's Quit method.
' Note that when you try to quit Microsoft Visio, the
' title bar blinks and a message is displayed asking if you
' want to save any loaded files.
    If VisioWasNotRunning = True Then
        MyVSO.Application.Quit
    End If

    Set MyVSO = Nothing    ' Release reference to the
                                ' application and sheet.
End Sub

Answer 1

It might be because visSelect isn't defined in Excel VBA.

Here's some verbose (but more flexible) code that illustrates a few more concepts along the way. The part you're looking for is just below '// Now, select shape #1:

Option Explicit

Public Sub SelectVisioShapeFromExcel()

  '// Setup:
  '// 1. Open blank Visio drawing
  '// 2. Draw 1 rectangle on the page
  '//    This will be Sheet.1

  Dim visApp As Object
  Set visApp = m_getVisAppOrNothing()

  If (visApp Is Nothing) Then
    '// The error handler will probably trigger before
    '// we get here:
    Debug.Print "Couldn't find Visio, exiting 'SelectVisioShapeFromExcel'"
    GoTo Cleanup
  End If

  '// Get the active page:
  Dim pg As Object
  Set pg = visApp.ActivePage
  If (pg Is Nothing) Then
    Debug.Print "Visio has no active page, exiting 'SelectVisioShapeFromExcel'"
    GoTo Cleanup
  End If

  '// We need to define the visSelect constant, since
  '// we're in another universe (Excel):
  '// Visio.VisSelectArgs.visSelect = 2
  Const visSelect As Integer = 2

  '// Now, select shape #1:
  Const ShapeID As Integer = 1 '//...in case you want to change it
  visApp.ActiveWindow.Select pg.Shapes.ItemFromID(ShapeID), visSelect

  GoTo Cleanup

ErrorHandler:
  Debug.Print "Error in SelectVisioShapeFromExcel:" & vbCrLf & Error$

Cleanup:
  Set visApp = Nothing
End Sub

Private Function m_getVisAppOrNothing() As Object

  '// Try to get a running instance of Visio, or fail
  '// and return Nothing.

  Set m_getVisAppOrNothing = Nothing

  On Error GoTo ErrorHandler

  '// Try and get Visio:
  Dim visApp As Object
  Set visApp = GetObject(, "Visio.Application")
  Set m_getVisAppOrNothing = visApp

  GoTo Cleanup

ErrorHandler:
  Debug.Print "Error in m_getVisAppOrNothing:" & vbCrLf & Error$
Cleanup:
  Set visApp = Nothing
End Function

Note that I've made a separate procedure for getting Visio. This better isolates any errors that might occur (like Visio not running), and keeps your main code more clean.

I also put in a chunk of code to get the ActivePage, just to demonstrate, as well as shorten the final selection code.

Answer 2

So today I opened up Visio and Excel, and whenever I tried to run my code from Excel, Visio would ask to activate Macros. So I saved the Visio file as a Macro-enabled drawing, and now my code is working! It's strange that the other day Visio didn't ask about enabling Macros, and instead just didn't respond at all.