Search code examples
.netvbavb.netvstovisio

Using Visio AddAdvise to add an event sink/handler to a Visio VSTO Add-in


I am trying to use Visio AddAdvise to add an event sink/handler to the ActiveDocument, in this case from a Visio VSTO Add-in.

This is the class:

Option Strict On

Imports System.Diagnostics
Imports Microsoft.Office.Interop
Imports Visio = Microsoft.Office.Interop.Visio


Public Class ShapeDeleteEventSink

    Implements Visio.IVisEventProc

    Public Function VisEventProc(nEventCode As Short, pSourceObj As Object, nEventID As Integer, nEventSeqNum As Integer, ByVal pSubjectObj As Object, ByVal vMoreInfo As Object) As Object Implements Visio.IVisEventProc.VisEventProc

        Debug.Print("A shape was deleted event fired")

        Return Nothing

    End Function

End Class

And this is the code to add the event handler/sink:

        Dim EventList As Visio.EventList = Globals.ThisAddIn.Application.ActiveDocument.EventList
        Dim ShapeDeleteEventSinkInstance As New ShapeDeleteEventSink
        Dim KeyDownEvent As Visio.Event = EventList.AddAdvise(CShort(Visio.VisEventCodes.visEvtCodeShapeDelete), ShapeDeleteEventSinkInstance, "", "A shape was deleted event fired")

The code compiles fine.

However running it leads to this exception:

System.Runtime.InteropServices.COMException HResult=0x86DB0898
Message=

An exception occurred. Source= StackTrace:

On the last line:

Dim KeyDownEvent As Visio.Event = EventList.AddAdvise(CShort(Visio.VisEventCodes.visEvtCodeShapeDelete), ShapeDeleteEventSinkInstance, "", "A shape was deleted event fired")

The VBA Class:

Implements Visio.IVisEventProc
 
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
 
 Debug.Print ("A shape was deleted!")
 
End Function

And code:

Sub AttachShapeDeleteEventSink()
    Dim EventList As Visio.EventList
    Dim ShapeDeleteEventSinkInstance As New ShapeDeleteEventSink
    Dim KeyDownEvent As Visio.Event
    
    Set EventList = Application.EventList
    Set KeyDownEvent = EventList.AddAdvise(visEvtCodeShapeDelete, ShapeDeleteEventSinkInstance, "", "This is a shape delete event")
End Sub

Run fine however.

Because COM provides poor error messages I can't really figure out why this doesn't work in the VSTO add-in.

One of the reasons I want to use AddAdvise is because I want to 'capture' events like KeyDown in a manner that provides me with the KeyboardEvent object. This allows me to easily capture shortcut keys the user is pressing in a Visio Window for instance.

That you for sharing your insights, I still only have a bit of a beginner understanding of how COM events work across the .NET interop.


Solution

  • You need to mark your Sink class com-visible:

    <ComVisible(True)> ' <----------- add this
    Public Class ShapeDeleteEventSink
    
        Implements Visio.IVisEventProc
        .....
    

    BTW, to handle keyboard messages you don't have to use AddAdvise, there is a "normal" event OnKeystrokeMessageForAddon