根据Excel表中的值在Visio中选择形状

Question

我在Excel表中有一个Visio形状ID的列表。当我在Excel中单击形状ID时，我希望Visio(同时打开(选择具有该ID的形状。

我重新调整了其他人打开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-ProjektePMO-ProjektePMO.0023 - LN+1 PMO7_ProzessLNplus_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没有询问是否启用宏，而是根本没有回应。