How to create a VBA class module to handle shape events?

Started by IRDC, August 30, 2011, 09:45:15 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

IRDC

Hi,
I'm trying to create an event handling module that I want to attach to every shape that is added to the document (or is there an easier way to attach shape event handlers to (nearly) every shape?).
I followed this MS manual:

but when it comes to the listener class they use "application" as an example:
'Code in the Class Module named Listener
Dim WithEvents m_app As Visio.Application
Private Sub Class_Initialize()
    Set m_app = Application
End Sub
Private Sub Class_Terminate()
    Set m_app = Nothing
End Sub
Private Sub m_app_ShapeAdded(ByVal Shape As IVShape)
    Debug.Print Shape.Document.Name; "/"; Shape.Name
End Sub

which makes it easy for them since "Application" is available everywhere. But what do I do initialize a class module with a shape reference?

I tried this:

'Class ShapeEventHandlers
Dim WithEvents DropedShape As Shape

Public Sub InitializeMe(ByVal myShape As Shape)
   DropedShape = myShape
End Sub

Public Static Function CreateInstance(ByVal myShape As Shape) As ShapeEventHandlers
   Dim myNewClass As New ShapeEventHandlers
   myNewClass.InitializeMe (myShape)
   CreateInstance = myNewClass
End Function

Private Sub Class_Initialize()

End Sub

In combination with this code in ThisDocument:

Dim AllShapes() As ShapeEventHandlers
Dim AllShapesCount As Integer

Private Sub Document_ShapeAdded(ByVal Shape As IVShape)
            Dim shapeEventHandler As ShapeEventHandlers
            shapeEventHandler = ShapeEventHandlers.CreateInstance(Shape)
           
            AllShapesCount = AllShapesCount + 1
            ReDim AllShapes(AllShapesCount)
            AllShapes(AllShapesCount) = shapeEventHandler
End Sub

But a type missmatch error is thrown in the CreateInstance Function.

aledlund

I'd start with a single event handler like the one demo'd in the v2010 sdk.
al

IRDC

I can't find a suitable example in the Visio Code Samples Library.chm. Also a single event handler is no solution since I could accomplish that with a simple variable but I need to listen to the ShapeLinkAdded and ShapeLinkDeleted events of every shape on every page of the document.
My main problem is handing a shape reference to the ShapeEventHandlers class which would enable me to create a class for every shape that is dropped.


Jumpy

There is sth. like a Connection Added event (for page or document) where in Connection.ToShape and .FromShape you can get the shape again. Maybe that's enough, too?

IRDC

I can't find such a sample and using the EventList with visEvtShapeLinkDeleted or visEvtShapeLinkAdded doesn't work. I tried using visEvtCell + visEvtMod which at least fires when a link is added but only sometimes when a link is deleted.

IRDC

I found a way to create a class instance and let it set the WithEvents variable in Class_Initialize.
The code now looks like this:

Class module ShapeEventHandlers

Dim WithEvents DropedShape As shape

Private Sub Class_Initialize()
    Set DropedShape = ThisDocument.GetLastShape()
End Sub

Private Sub Class_Terminate()
    Set DropedShape = Nothing
End Sub

Private Sub DropedShape_ShapeLinkAdded(ByVal shape As IVShape, ByVal DataRecordsetID As Long, ByVal DataRowID As Long)
    If shape.CellExistsU("User.ShowHyperlinkIcon", visExistsAnywhere) Then
        shape.CellsU("User.ShowHyperlinkIcon").ResultIUForce = 1
    End If
End Sub

Private Sub DropedShape_ShapeLinkDeleted(ByVal shape As IVShape, ByVal DataRecordsetID As Long, ByVal DataRowID As Long)
    If shape.CellExistsU("User.ShowHyperlinkIcon", visExistsAnywhere) And shape.Hyperlinks.count = 0 Then
        shape.CellsU("User.ShowHyperlinkIcon").ResultIUForce = 0
    End If
End Sub


ThisDocument

Dim shapesCol As New Collection
Dim lastShape As Visio.shape

Public Function GetLastShape() As Visio.shape
    Set GetLastShape = lastShape
End Function

Private Sub Document_ShapeAdded(ByVal shape As IVShape)
    If shape.CellExistsU("User.ShowHyperlinkIcon", visExistsAnywhere) Then
        Set lastShape = shape
        Dim shapeEventHandler As New ShapeEventHandlers
        shapesCol.Add (shapeEventHandler)
    End If
End Sub


This throws an runtime error 438 at shapesCol.Add (shapeEventHandler). Just to test the code with the last added shape I replaced the Collection with a variable which will cause no error. But right after ShapeEventHandlers.Class_Initialize() is executed Class_Terminate() is executed and the object is gone again.

IRDC

OK, fixed it. I was looking at the wrong events. ShapeLinkAdded concers data connections. Now I listen to ExitScope and compare the nScopeID to 1585, 1619 and 1609 to handle hyperlink related changes.