How to get a local shape name from a BeforeShapeDelete event in Visio - vba

Question

I've created an event sink module using this code I found online (can't remember where it was now, it was from a tutorial). It's split into a class module and a standard module.
The standard module:
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
And the class module:
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
Now, my question in particular is about the BeforeShapeDelete event. When I delete a shape, I've set up the code to print to Visual Basic's debug window the name of the shape that will be deleted. The only issue is, it prints the global name (e.g. Sheet.1, Sheet.2, Sheet.3, etc.) If I were to create a shape, rename it using the Shape Name menu in the Developer tab to something else, e.g. "Square", and then delete that shape, it still prints a shape name of the form Shape.XX rather than whatever I renamed it to. How can I get the non-global shape name instead? I've tried pSubjectObj.PrimaryItem.LocalName but that doesn't come up as a valid property of the class object.

Answer 1

I don't know the answer to your question (why you don't get name there), but maybe I could suggest something. Please note that when you try to access the shape identifier, the shape is already deleted. If you want to be notified before deletion, you could use visEvtCodeBefSelDel code.
Or better yet, don't use AddAdvise/VisEventProc (unless you absolutely have to for whatever reason), and go with a simple straightforward approach of using "BeforeSelectionDelete" event. Meaning, remove the class module, and instead of your code, simply put in "ThisDocument":
Private Sub Document_BeforeSelectionDelete(selection)
Debug.Print selection.PrimaryItem.Name
End Sub
And it should work.