Handling Visio events in MS Access

[Yacine]

I need to catch two events from Visio within my MS Access VBA code. "Selection changed" and "Before closing".


You can find many things related to event handling inside of Visio itself, some for .Net and C#, but Access is somehow neglected.


Can anyone help?

[Thomas Winkel]

Moin Yacine

I never used Access, but I catch Excel events from Visio using VBA.
I guess the proceeding must be very similar, so this may be helpful.

Have a look at Class Module ExcelEventClass and Module ShapeData:
http://visguy.com/vgforum/index.php?topic=7581.0

Unfortunately this works only using early binding.
At least I was not able to make this work using late binding.
This is a problem if you want to deploy your solution.

Hope that helps.

[Yacine]

Das ist zum Haare raufen.

Thank you Thomas,
tried your code, but could only get it to work with "Set visioAppEvents = NEW Visio.Application", which is a late binding, as Google's Gemini explained to me. https://g.co/gemini/share/4188f8b9aeda
I have set the reference to "Microsoft Visio 16.0 Type Library".
Have even tried the other Visio libraries (drawing control, save as web, database modeling and viewer). Despite it doesn't make sense at all.
Tried setting higher priority for this library, nope.

Funny enough the following code works fine, which I thought to be an early binding.

Code Select Expand

Option Compare Database
Option Explicit

'Public vApp As New visioEventClass

'--- FOR EARLY BINDING
Public vApp As Visio.Application
Public vDoc As Visio.Document
Public vPg As Visio.Page
Public vWin As Visio.Window

'--- FOR LATE BINDING
'Public vApp As Object
'Public vDoc As Object
'Public vPg As Object
'Public vWin As Object


Public vSaved As Boolean
Public vFullName As String
Public vDocName As String

'--- Visio constants
Public Const visTypeGroup = 2
Public Const visBBoxUprightWH = 1
Public Const visSelect = 2
Public Const visRowLast = -2
Public Const visTagDefault = 0
Public Const visFmtNumGenNoUnits = 0

Public Const visSectionProp = 243
Public Const visSectionUser = 242
Public Const visSectionControls = 9
Public Const visSectionObject = 1
Public Const visSectionAction = 240
Public Const visCustPropsSortKey = 4

Public Const visMillimeters = 70

Public Const NA = "-----"

Function getVisioShort() As Boolean
    If vPg Is Nothing Then
        getVisioShort = getVisio(vApp)
    Else
        getVisioShort = True
    End If
End Function

Function getVisio(ByRef vApp As Object, Optional docName As String, Optional pageName As String) As Boolean
    On Error Resume Next
   
    Dim obj As Object
    Dim bFound As Boolean
    Dim dlgRes As Integer
    Dim tempWin As Object
   

    Set vApp = GetObject(, "Visio.Application")
    If Err.Number = 429 Then
        Err.Clear
        Set vApp = CreateObject("Visio.Application")
        If Err.Number = 429 Then
            Err.Clear
            MsgBox "Es konnte nicht auf 'Microsoft Visio' zugegriffen werden!", vbExclamation, "Fehler beim Zugriff auf MS Visio"
            getVisio = False
            Exit Function
        End If
    End If

    DoEvents
    If docName <> "" Then
        For Each obj In vApp.Documents
            If obj.Name = docName Then
                bFound = True
                Set vDoc = obj
                Exit For
            End If
        Next obj
       
        If Not bFound Then
            If FileExists(docName) Then
                Set vDoc = vApp.Documents.Open(docName)
                DoEvents
            Else
                MsgBox "Die Datei existiert nicht, bitte Datei auswählen", vbOKOnly
                docName = getFileName("Visio-Datei öffnen", "Visio-Zeichnung (*.vs*)\0*.vs*\0\0")
                Set vDoc = vApp.Documents.Open(docName)
                DoEvents
            End If
        End If
    End If
   
    If vDoc Is Nothing Then
        Set vDoc = vApp.activedocument
        If vDoc Is Nothing Then
            MsgBox "Kein aktives Visio Dokument", vbOKOnly
            getVisio = False
            Exit Function
        End If
    End If
   
    vDocName = vDoc.Name
    vFullName = vDoc.Path & vDoc.Name
   
    If pageName <> "" Then
        bFound = False
        For Each obj In vDoc.Pages
            If obj.Name = pageName Then
                Set vPg = obj
                bFound = True
                Exit For
            End If
        Next obj
        If Not bFound Then
            dlgRes = MsgBox("Die Seite " & pageName & "existiert nicht. Soll sie eingerichtet werden?", vbYesNo)
            If dlgRes = vbYes Then
                Set vPg = vDoc.Pages.AddItem(pageName)
            End If
        End If
    End If
   
    If vPg Is Nothing Then
        Set vPg = vDoc.Pages(1)
    End If
   
    For Each tempWin In vApp.Windows
        If tempWin.Document.Name = vDoc.Name Then
            vApp.Windows.item(tempWin.index).Activate
            vApp.ActiveWindow.Page = vPg.Name
            Set vWin = vApp.ActiveWindow
            Exit For
        End If
    Next tempWin
   
    If vWin Is Nothing Then
        Set vWin = vApp.ActiveWindow
    End If
   
    '------------------- Stencils --------------------
    loadStencils
   
    getVisio = True
End Function

Sub loadStencils()
    Dim Path_ As String
    Dim aStencils As Variant
    Dim vStencil As Variant
    Dim vDoc As Object
    Dim docName As String
    Dim docNameList As String
    Dim aDocs As Variant
   
    Path_ = Setting("Ref_Path", "Settings")
    aStencils = Split(Setting("Stencils", "Settings"), ";")

    For Each vDoc In vApp.Documents
        docNameList = docNameList & vDoc.Name & ";"
    Next vDoc
    If Right(docNameList, 1) = ";" Then docNameList = Left(docNameList, Len(docNameList) - 1)
    For Each vStencil In aStencils
        If InStr(docNameList, vStencil) = 0 Then
            vApp.Documents.OpenEx Path_ & vStencil, &H2 + &H4
        End If
    Next vStencil
End Sub


I suspect Gemini to bullshitting me.

[Nikolay]

With Access it is pretty much the same as with Visio (you can use the "early binding"),
just add a reference to the Visio library (Microsoft Visio 16.0 Type Library)

Then declare a variable in your class module to hold the Visio application (using the "WithEvents" keyword).
It does not have to be application, it can be any object taht has events:

Code Select Expand


Dim WithEvents app as Visio.Application

Then you can just add event handlers like in Visio (you cna use the dropdown boxes at the top of the window):

[Thomas Winkel]

I suspect Gemini to bullshitting me.

I think so too
The only point about early / late binding is how an object variable is declared.
If it's declared "As Object" it's late binding.
If it's declared "As Type" it' early binding.
Early binding requires a Reference to the library.
Then it's known to compile time what type of object will be stored.
It also gives the great benefit of IntelliSense in the editor.
The big disadvantage is, that references can break on other installations (e.g. because of different application versions).

For that reason I use to develop in early binding and switch to late binding before publishing.
In my code it's a mixture because I tried to make it work with late binding without result.
Also forget the line "Set ExcelAppEvents = Excel.Application" that's nonsense garbage code.

I attached a minimal example in Excel.