Выберите фигуру в Visio на основе значения в таблице Excel

Question

У меня есть список идентификаторов фигур Visio в таблице Excel. Когда я нажимаю на идентификатор фигуры в Excel, я хочу, чтобы Visio (одновременно открыт) выбрал фигуру с этим идентификатором.

Я переназначил некоторый код от другого, который открывает Excel и разрешает изменения из Visio, но теперь это идет в другом направлении. Итак, это первая проблема ... возможно, вызов Visio как объекта немного отличается от Excel.

Код не выдает никаких ошибок, он просто не выбирает форму.

Вторая возможность заключается в том, что мой синтаксис для выбора в Visio неправильный.

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

Возможно, это связано с тем, что visSelect не определено в Excel VBA.

Вот несколько подробных (но более гибких) кодов, которые иллюстрируют еще несколько понятий. Часть, которую вы ищете, находится чуть ниже '// Теперь выберите фигуру # 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

Обратите внимание, что я сделал отдельную процедуру для получения Visio. Это лучше изолирует любые ошибки, которые могут возникнуть (например, Visio не работает), и сохраняет ваш основной код более чистым.

Я также вставил кусок кода, чтобы получить ActivePage, просто чтобы продемонстрировать, а также сократить окончательный код выбора.

Answer 2

Итак, сегодня я открыл Visio и Excel, и всякий раз, когда я пытался запустить свой код из Excel, Visio просил активировать макросы. Поэтому я сохранил файл Visio как рисунок с поддержкой макросов, и теперь мой код работает! Странно, что на днях Visio не спрашивал о включении макросов, а просто не отвечал вообще.