如何从Visio中的BeforeShapeDelete事件中获取本地形状名称

Question

我已经用我在网上找到的这段代码创建了一个事件接收器模块(记不清它现在在哪里了，它来自教程(。它分为类模块和标准模块。

标准模块：

Option Explicit

Private mEventSink As clsEventSink

Dim vsoDocumentEvents As Visio.EventList        'Events of the Document class
'DOCUMENT-CLASS EVENTS
Dim vsoDocumentSavedEvent As Visio.Event
Dim vsoPageAddedEvent As Visio.Event
Dim vsoShapesDeletedEvent As Visio.Event

Private Const visEvtAdd% = &H8000
Public Sub CreateEventObjects()

'Create an instance of the clsEventSink class
'to pass to the AddAdvise method.
Set mEventSink = New clsEventSink

'Get the EventList collection of the active document.
Set vsoDocumentEvents = ActiveDocument.EventList
Set vsoAppEvents = Application.EventList
'Add an Event object for the BeforeShapeDelete event.
Set vsoShapesDeletedEvent = vsoDocumentEvents.AddAdvise(visEvtCodeShapeDelete, mEventSink, "", "Shapes deleted...")

'Add an Event object for the DocumentSaved event.
Set vsoDocumentSavedEvent = vsoDocumentEvents.AddAdvise(visEvtCodeDocSave, mEventSink, "", "Document saved...")

'Add an Event object for the PageAdded event.
Set vsoPageAddedEvent = vsoDocumentEvents.AddAdvise(visEvtAdd + visEvtPage, mEventSink, "", "Page added...")

End Sub

Public Sub DeleteEventObjects()
'Delete the Event object for the DocumentSaved event.
vsoDocumentSavedEvent.Delete
Set vsoDocumentSavedEvent = Nothing

'Delete the Event object for the PageAdded event.
vsoPageAddedEvent.Delete
Set vsoPageAddedEvent = Nothing

'Delete the Event object for the ShapesDeleted event.
vsoShapesDeletedEvent.Delete
Set vsoShapesDeletedEvent = Nothing
End Sub

和类模块：

Implements Visio.IVisEventProc
Private Const visEvtAdd% = &H8000

Private Function IVisEventProc_VisEventProc( _
ByVal nEventCode As Integer, _
ByVal pSourceObj As Object, _
ByVal nEventID As Long, _
ByVal nEventSeqNum As Long, _
ByVal pSubjectObj As Object, _
ByVal vMoreInfo As Variant) As Variant

''''''''''''''''''''''''''''''''''''''''''''''''
Select Case nEventCode
Case visEvtCodeDocSave
'YOUR CODE FOR WHAT HAPPENS WHEN THE USER SAVES THE DOCUMENT GOES HERE
Debug.Print "DocumentSaved (" & Hex(nEventCode) & ")"

''''''''''''''''''''''''''''''''''''''''''''''''
Case (visEvtPage + visEvtAdd)
Debug.Print "Page Added (" & Hex(nEventCode) & ")"

''''''''''''''''''''''''''''''''''''''''''''''''
Case visEvtCodeShapeDelete
'YOUR CODE FOR WHAT HAPPENS WHEN THE USER DELETES A SHAPE GOES HERE
'Debug.Print "ShapesDeleted(" & Hex(nEventCode) & ")"

Debug.Print pSubjectObj.PrimaryItem.Name
'returns Sheet.??? instead of the desired local name

''''''''''''''''''''''''''''''''''''''''''''''''
Case Else
'YOUR CODE FOR WHAT HAPPENS WHEN AN EVENT NOT LISTED ABOVE OCCURS, GOES HERE
Debug.Print "Other (" & Hex(nEventCode) & ")"
End Select

End Function

现在，我的问题特别是关于BeforeShapeDelete事件。当我删除一个形状时，我已经设置了将要删除的形状的名称打印到Visual Basic的调试窗口的代码。唯一的问题是，它打印全局名称(例如Sheet.1、Sheet.2、Sheet.3等(。如果我要创建一个形状，请使用Developer选项卡中的Shape Name菜单将其重命名为其他名称，例如"；正方形"；，然后删除该形状，它仍然打印表单Shape.XX的形状名称，而不是我重命名它的名称。如何获取非全局形状名称？我尝试过pSubjectObj.PrimaryItem.LocalName，但它不是类对象的有效属性。

Answer 1

我不知道你的问题的答案(为什么你没有在那里得到名字(，但也许我可以提出一些建议。请注意，当您尝试访问形状标识符时，该形状已被删除。如果您想在删除前得到通知，可以使用visEvtCodeBefSelDel代码。

或者更好的是，不要使用AddAdvise/VisEventProc(除非你出于任何原因绝对必须使用(，并使用一种简单直接的方法，即使用"；BeforeSelectionDelete"；事件意思是，删除类模块，而不是您的代码，只需放入"；本文件"：

Private Sub Document_BeforeSelectionDelete(selection)
Debug.Print selection.PrimaryItem.Name
End Sub

它应该起作用。